

C-----------------------------------------------------------------------------

      SUBROUTINE ANCWL

C-----------------------------------------------------------------------------

C     DISPERSION RELATION FOR ACOUSTIC WAVES NO CURRENT, WITH LOSSES

C     COMMON DECK "RKAM" INSERTED HERE 

      implicit double precision (a-h,o-z)

      DOUBLE PRECISION KR,KTH,KPH

      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20) 

C     COMMON DECK "CC" INSERTED HERE

      DOUBLE PRECISION MODC

      COMMON/CC/MODC(4),CS,PCST,PCSR,PCSTH,PCSPH  

C     COMMON DECK "CONST" INSERTED HERE

      COMMON/PCONST/CREF,RGAS,GAMMA 

      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10

C     COMMON DECK "RK" INSERTED HERE 

C     DEFINE SIZE REQUIRED FOR RAY STATE SAVE ARRAY 

      PARAMETER (LRKAMS=87+2*100,NXRKMS=12+LRKAMS,MXEQPT=21) 

      PARAMETER (NRKSAV=NXRKMS+MXEQPT-1)

      COMMON /RK/ NEQS,STEP,MODE,E1MAX,E1MIN,E2MAX,E2MIN,FACT,RSTART

C     COMMON DECK "RINREAL" INSERTED HERE

      LOGICAL SPACE

      DOUBLE PRECISION LPOLAR,LPOLRI,KPHK,KPHKI,KAY2,KAY2I

      CHARACTER DISPM*6 ,modrin*64 

      COMMON/RINPL/DISPM

      COMMON /RIN/ MODRIN,RAYNAME(2,3),TYPE(3),SPACE

      COMMON/RIN/OMEGMIN,OMEGMAX,KAY2,KAY2I,

     1              H,HI,PHT,PHTI,PHR,PHRI,PHTH,PHTHI,PHPH,PHPHI

     2, PHOW,PHOWI,PHKR,PHKRI,PHKTH,PHKTI, PHKPH,PHKPI 

     3 ,KPHK,KPHKI,POLAR,POLARI,LPOLAR,LPOLRI,SGN 

C     COMMON DECK "UU" INSERTED HERE

      DOUBLE PRECISION MODU

      COMMON/UU/MODU(4)

     1  ,V  ,PVT  ,PVR  ,PVTH  ,PVPH 

     2  ,VR ,PVRT ,PVRR ,PVRTH ,PVRPH

     3  ,VTH,PVTHT,PVTHR,PVTHTH,PVTHPH

     4  ,VPH,PVPHT,PVPHR,PVPHTH,PVPHPH

      COMMON/WW/dum(10),MAXW,W(1000)

      DOUBLE PRECISION MAXSTP,MAXERR,INTYP,LLAT,LLON

C     COMMON DECK "LL" INSERTED HERE

      DOUBLE PRECISION MODL

      COMMON/LL/MODL(4),APH,APHPT,APHPR,APHPTH,APHPPH 

      DOUBLE PRECISION KS,MKS

      DOUBLE PRECISION KVECT(24)

      DOUBLE PRECISION VSET(20)

      EQUIVALENCE(KVECT,KAY2),(VSET,V),(ow,w(6))

      DOUBLE PRECISION   TBPE( 3)

      CHARACTER DLSPM*5

      DATA DLSPM/'ANCWL'/

      DATA TBPE/3*1H2 / 

C

C

      ENTRY SETDSP 

	modrin = 'ACOUSTIC WAVE --- NO CURRENT --- WITH LOSSES'

      DISPM=DLSPM  

      CALL RMOVE(TYPE,TBPE, 3)

      CALL SETSPD

      CALL SETRCV

      CALL SETTOP

      CALL SETSUR

      RETURN 

C

      ENTRY IDISPER

      CALL ISPEED

      CALL IRECVR

      CALL ITOPOG

      CALL ISURFAC

      CALL IABSRP

      RETURN 

C

      ENTRY DISPER

      ENTRY RINDEX

      SPACE=.FALSE.

      KS=KR*KR+KTH*KTH+KPH*KPH 

C     SOUND SPEED

      CALL SPEED 

      OWS=OW*OW  

      KAY2=OWS/CS

      H=OW*OW - CS*KS

      MKS=-KS

      PHT=MKS*PCST

      PHR=MKS*PCSR

      PHTH=MKS*PCSTH

      PHPH=MKS*PCSPH

      PHOW=2.d0*OW

      CS2=-2.d0*CS

      PHKR=CS2*KR

      PHKTH=CS2*KTH

      PHKPH=CS2*KPH

      KPHK=CS2*KS

      CALL ABSRP

      GMS=GAMMA-1.d0

      KAY2I=-dSQRT(KAY2)*APH

      RETURN

      END 

                                                                                



