C 
C     PROGRAM  WEAKAN
C
C*******************************************************************
C
C     PROGRAM WEAKAN IS DESIGNED FOR CALCULATIONS IN THE QI
C     APPROXIMATION
C
C*******************************************************************
C
C
      CHARACTER*80 MTEXT,FILEIN,FILEOU,FILE1,FILE2
      COMPLEX AY,W
      DIMENSION W(2),DST(100),P1(2000),P2(2000),P3(2000)
      COMMON /RAYW/ AY(3,2000),E(3,3,2000),OMEGA,N,NTOT,IND,IND1
      COMMON /AUXI/  IANI(20),INTR,INT1,IPREC,KRE,IREFR,LAY,NDER,IPRINT,
     1 MPRINT,NTR,ISQRT,NAUX,ISOUR,MAUX,MREG,MDIM,IPOL,MSCON,LOU,
     2 IAMP,MTRNS,ICOEF,IAD,IRHO,ISHEAR,IAC,IRT,mori
      COMMON /ISOTR/T(2000),X(2000),Y(2000),Z(2000),VP(2000),VS(2000),
     1RHO(2000)
      COMMON /FORCE/ F(3)
C
C**************************************************
C
      LIN=5
      LOU=6
      LU1=1
      LU6=2
      FILEIN='weakan.dat'
      FILEOU='weakan.out'
      FILE1='lu1.dat'
      FILE2='lu6.dat'
      WRITE(*,'(2A)') ' SPECIFY NAMES OF INPUT AND OUTPUT FILES',
     1' LIN, LOU, LU1, LU6: '
      READ(*,*) FILEIN,FILEOU,FILE1,FILE2
      IF(FILE1.EQ.' ') LU1=0
      IF(FILE2.EQ.' ') LU6=0
      OPEN(LIN,FILE=FILEIN,FORM='FORMATTED',STATUS='OLD')
      OPEN(LOU,FILE=FILEOU,FORM='FORMATTED')
      IF(LU1.NE.0)OPEN(LU1,FILE=FILE1,FORM='FORMATTED',STATUS='OLD')
      IF(LU6.NE.0)OPEN(LU6,FILE=FILE2,FORM='FORMATTED')
C
C**************************************************
C
      WRITE(LOU,777)
 777  FORMAT(///,'***********************'
     1,//,'  PROGRAM   W E A K A N      ',//,
     2'***********************',//)
      MTEXT='WEAKAN'
      INULL=4
      INEWB=0
      READ(LIN,*)MTEXT
      WRITE(LOU,115)MTEXT
      READ(LIN,*)INULL,INEWB
      RNULL=10.**(-INULL)
      WRITE(LOU,100)INULL,INEWB
      IND1=INEWB
C
C
C     SPECIFICATION OF THE MODEL
C
      CALL MODEL(MTEXT,LIN)
C
      READ(LIN,*)F
      WRITE(LOU,104)F
      READ(LIN,*)FL,FD,NF
      WRITE(LOU,102)FL,FD,NF
      WRITE(LU6,107)FL,FD,NF
      TSOUR=0.
C
C     READS FILE LU1 FOR WITH INFORMATION ON RAYS
C
      READ(LU1,100)ICONT,NDST,ILOC
      READ(LU1,104)RO
      READ(LU1,100)NPN,NPN,NPN
      READ(LU1,101)APN,APN,APN,APN,APN
      READ(LU1,101)APN,APN,APN,APN,APN
      READ(LU1,104)APN,APN,APN,APN
      READ(LU1,104)(DST(I),I=1,NDST)
    2 READ(LU1,103)NTOT,NRAY
      IF(NTOT.EQ.0)GO TO 5
      READ(LU1,105)(T(J),X(J),Y(J),Z(J),P1(J),P2(J),P3(J),VP(J),
     1VS(J),RHO(J),(E(1,K,J),K=1,3),(E(2,L,J),L=1,3),J = 1,NTOT)
      DO 3 J=1,NTOT
      AUX=SQRT(P1(J)*P1(J)+P2(J)*P2(J)+P3(J)*P3(J))
      E(3,1,J)=P1(J)/AUX
      E(3,2,J)=P2(J)/AUX
      E(3,3,J)=P3(J)/AUX
      VP(J)=SQRT(VP(J))
      VS(J)=SQRT(VS(J))
    3 CONTINUE
      LAY=1
C
      FF=FL
      WRITE(LU6,105)(E(1,K,NTOT),K=1,3),(E(2,L,NTOT),L=1,3)
      DO 4 J=1,NF
      OMEGA=6.2831853*FF
      CALL RAYB(W,TSOUR,DT)
      WRITE(LU6,105)FF,W
      FF=FL+FLOAT(J)*FD
    4 CONTINUE
      GO TO 2
C
  100 FORMAT(26I3)
  101 FORMAT(5E15.5)
  102 FORMAT(2F10.5,I5)
  103 FORMAT(2I5)
  104 FORMAT(8F10.5)
  105 FORMAT(16E15.5)
  106 FORMAT(1X,6(F10.5))
  107 FORMAT(2F10.5,I5)
  115 FORMAT(A)
C
    5 CONTINUE
      STOP
      END
C
C
C=======================================================================
C
      INCLUDE 'wk.for'
C     wk.for
      INCLUDE 'modbs.for'
C     modbs.for
C
C=======================================================================
C