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

      SUBROUTINE WTIDE

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

C     WIND VELOCITY MODEL

C     PROVIDES WIND FIELD OF THE ATMOSPHERIC TIDES BY ZONAL AND

C     MERIDONAL HEIGHT PROFILES THAT ARE SINUSOIDAL AND IN PHASE

C     QUADRATURE.



C     Compile with options /c (compile only) and /4Yb (error tracing)

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



      real*8 LAMZ

C     COMMON DECK "RKAM" INSERTED HERE

      real*8 KR,KTH,KPH

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

C     COMMON DECK "UU" INSERTED HERE

      real*8 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

C     COMMON DECK "WW" INSERTED HERE

      common/ww/ dum(10),maxw,w(1000)

C

C     WIND        100-124

      EQUIVALENCE (W(100),UMODEL),(W(101),UFORM),(W(102),UID)

C

C     COMMON DECK "B1" INSERTED HERE

      INTEGER UMX,UNTBL,UITBL,UFRMTBL,IDSU(10)

      COMMON/B1/UMX,UNTBL(10),UITBL(10),UFRMTBL(10),UGP(10)

      EQUIVALENCE (UGP,IDSU),(earthr,w(1))

C     COMMON DECK "CONST" INSERTED HERE

      COMMON/PCONST/CREF,RGAS,GAMMA

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

      EQUIVALENCE (W(103),UPH0),(W(104),UTH0)

      EQUIVALENCE (W(105),LAMZ),(W(106),TTAU),(W(107),TAU)

      INTEGER UPX,UQTBL(10),ULTBL(10),UIRMTBL(10)   

      DATA RECOGU/5.d0/

      DATA UPX/1/

      DATA UQTBL/1,11,8*0/

      DATA ULTBL/1,9*0/

      DATA UIRMTBL/1,9*0/

C

      ENTRY SETWND

      UMX=UPX

      CALL IMOVE(UNTBL,UQTBL,10)

      CALL IMOVE(UITBL,ULTBL,10)

      CALL IMOVE(UFRMTBL,UIRMTBL,10)

      CALL SETPWN

      RETURN

C

      ENTRY IWINDR

C

      IF(idint(RECOGU) .NE. idint(UMODEL))

     1    CALL RERROR('WIND   ','WRNG MODEL',RECOGU)

C

      MODU(1)=5HWTIDE

      MODU(2)=UID

      CALL IPWINDR

C

      Q=PID2/LAMZ

      S=PID2/TAU

      RETURN

C

      ENTRY WINDR

C

      CALL CLEAR(V,20)

C

      ARG=PID2*((R-EARTHR)/LAMZ+TTAU)

C

      CSA=COS(ARG)

      SSA=SIN(ARG)

      VTH=UTH0*SSA

      VPH=UPH0*CSA

C

      PVTHR=CSA*Q*UTH0

      PVPHR=SSA*Q*UPH0

C      V=SQRT(VTH*VTH+VPH*VPH)

      PVTHT=CSA*S*UTH0

      PVPHT=SSA*S*UPH0

      CALL PWINDR

      RETURN

      END

