C                            DERIVAIVE
      SUBROUTINE DER(DSP,LU,ND,DR,IP,N,IS)
C
      DIMENSION A(25)
      BYTE DSP,ND
C
      IS=0 !STATUS 0 DO NOT PLOT  1 OK TO PLOT
      IH=ND/2+1
      IF(IP.LT.IH) RETURN
      IF(IP.GT.(N-IH)) RETURN
      IS=1
      JS=IP-IH
C
      DO 100 I=1,ND
      J=I+JS
      READ(LU'J) B
  100 A(I)=B
      IF(DSP.EQ.5) CALL DER1(A,DR,ND)
      IF(DSP.EQ.6) CALL DER2(A,DR,ND)
      RETURN
      END
C
      SUBROUTINE DER1(A,D1,ND1)
C
      BYTE ND1
      DIMENSION A(25)
C
      IF(ND1.NE.25) GO TO 100
      D1=30866.*(A(1)-A(25))+8602.*(A(2)-A(24))+8525.*(A(23)-A(3))
     1+20982.*(A(22)-A(4))+29236.*(A(21)-A(5))+33754.*(A(20)-A(6))
     2+35003.*(A(19)-A(7))+33450.*(A(18)-A(8))+29562.*(A(17)-A(9))
     3+23806.*(A(16)-A(10))+16649.*(A(15)-A(11))+8558.*(A(14)-A(12))
      D1=D1/1776060.
      GO TO 700
  100 IF(ND1.NE.19) GO TO 200
      D1=6936.*(A(1)-A(19))+68.*(A(2)-A(18))+4648.*(A(17)-A(3))
     1+7481.*(A(16)-A(4))+8700.*(A(15)-A(5))+8574.*(A(14)-A(6))
     2+8179.*(A(13)-A(7))+5363.*(A(12)-A(8))+2816.*(A(11)-A(9))
      D1=D1/255816.
      GO TO 700
  200 IF(ND1.NE.15) GO TO 300
      D1=12922.*(A(1)-A(15))+4121.*(A(14)-A(2))+14150.*(A(13)-A(3))
     1+18334.*(A(12)-A(4))+17842.*(A(11)-A(5))+13843.*(A(10)-A(6))
     2+7506.*(A(9)-A(7))
      D1=D1/33415.
      GO TO 700
  300 IF(ND1.NE.11) GO TO 400
      D1=300.*(A(1)-A(11))+294.*(A(10)-A(2))+532.*(A(9)-A(3))
     1+503.*(A(8)-A(4))+296.*(A(7)-A(5))
      D1=D1/5148.
      GO TO 700
  400 IF(ND1.NE.9) GO TO 500
      D1=86.*(A(1)-A(9))+142.*(A(8)-A(2))+193.*(A(7)-A(3))+126.*(A(6)
     1-A(4))
      D1=D1/1188.
      GO TO 700
  500 IF(ND1.NE.7) GO TO 600
      D1=22.*(A(1)-A(7))+67.*(A(6)-A(2))+58.*(A(5)-A(3))
      D1=D1/252.
      GO TO 700
  600 IF(ND1.NE.5) GO TO 999
      D1=A(1)-A(5)+8.*(A(4)-A(3))
      D1=D1/12.
  700 RETURN
  999 TYPE *,'*****************************************************'
      WRITE(6,1000) ND1
 1000 FORMAT(1X,I2,' NOT ALLOWED FOR 1ST DERIVATIVE')
      TYPE *,'*****************************************************'
      STOP  '  SORRY '
      END
C
      SUBROUTINE DER2(A,D2,ND2)
C                                                           **********
C                                                           ** DER2 **
C                                                           **********
CLAB= DER2
C 2ND DERIVATIVE
C ND2=05,07,09,11,15,19,25
      BYTE ND2
      DIMENSION A(25)
      IF(ND2.NE.11) GO TO 10
      D2=15.*(A(1)+A(11))+6.*(A(2)
     &+A(10))-1.*(A(3)+A(9))
     &-6.*(A(4)+A(8))-9.*(A(5)+A(7))-10.*A(6)
      D2=D2/429.
      GO TO 26
   10 IF(ND2.NE.25) GO TO 20
      D2=92.*(A(1)+A(25))+69.*(A(2)+A(24))
     &+48.*(A(3)+A(23))+29.*(A(4)+A(22))
     &+12.*(A(5)+A(21))-3.*(A(6)+A(20))-16.*(A(7)+
     &A(19))-27.*(A(8)+A(18))-36.*(A(9)+A(17))-43.*(
     &A(10)+A(16))-48.*(A(11)+A(15))
     &-51.*(A(12)+A(14))-52.*A(13)
      D2=D2/26910.
      GO TO 26
   20 IF(ND2.NE.5) GO TO 21
      D2=2.*(A(1)+A(5))-1.*(A(2)+A(4))-2.
     &*A(3)
      D2=D2/7.0
      GO TO 26
   21 IF(ND2.NE.19) GO TO 22
      D2=51.*(A(1)+A(19))+34.*(A(2)+A(18))
     &+19.*(A(3)+A(17))+6.*(A(4)+A(16))
     &-5.*(A(5)+A(15))-14.*(A(6)+A(14))
     &-21.*(A(7)+A(13))-26.*(A(8)+A(12))
     &-29.*(A(9)+A(11))-30.*A(10)
      D2=D2/6783.
      GO TO 26
   22 IF(ND2.NE.7) GO TO 23
      D2=5.*(A(1)+A(7))-3.*(A(3)+A(5))-4.*A(4)
      D2=D2/42.0
      GO TO 26
   23 IF(ND2.NE.9) GO TO 24
      D2=28.*(A(1)+A(9))+7.*(A(2)+A(8))-8.*(A(3)+A(7))
     &-17.*(A(4)+A(6))-20.*A(5)
      D2=D2/462.0
      GO TO 26
   24 IF(ND2.NE.15) GO TO 25
      D2=91.*(A(1)+A(15))+52.*(A(2)+A(14))+19.*(A(3)+A(13))
     &-8.*(A(4)+A(12))-29.*(A(5)+A(11))-44.*(A(6)+A(10))
     &-53.*(A(7)+A(9))-56.*A(8)
      D2=D2/6188.
      GO TO 26
   25 CONTINUE
      TYPE *,'*************************************************'
      WRITE(6,1000) ND2
 1000 FORMAT(1X,I2,' NOT ALLOWED FOT 2ND DERIVATIVE')
      TYPE *,'************************************************'
      STOP ' SORRY'
   26 RETURN
      END
