      SUBROUTINE ZANGVR(UIN,  VIN,  SGI
Status: R

     *,                 CPHV, SPHV, PHV, XCR, SGB, SIG
     *,                 PHO,  BLO,  SGO, CBV, SBV, CP1, WK1, WK2 
     *,                 TX1,  TX2,  TX3)
#include "slgcm.slgprm"
C
      DIMENSION  UIN(IJM0M0),  VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),  BLO(IJM0M0), SGO(IJM0M0)
     *,          CPHV(IJM0M0), SPHV(IJM0M0), PHV(IJM0M0)
     *,          CBV(IJM0M0),  SBV(IJM0M0),  XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0),  CP1(IJM0M0)
     *,          TX1(IJP3M0),  TX2(IJP3M0),  TX3(IJP3M0)
C
C      COMPUTE U AT V-POINTS I.E. UVPT(I,J)
C
      CALL VPTU(IJM0M0, UIN, WK1, TX1, TX2, TX3, IJP3M0)
C
      DO 70 I=1,IJM1M0
      WK1(I) =  WK1(I) * 0.5
      WK2(I) =  VIN(I) * 0.5
   70 CONTINUE
C
      IF (ROTATE) THEN
C
C     COMPUTE FOR SOUTH OF THETAM
C
C        JC=3
         CALL ANGUVR(JSV1M0, CPHV, SPHV, WK1, WK2, PHO, CBV, SBV, CP1)
C
C     COMPUTE FOR THE EQUATORIAL POINTS
C
         JC = (JSV-1) * IMP3
C
         DO 200 I=1,JVP0M0
         PHO(I+JC) =  PHV(I+JC) - WK2(I+JC)
  200    CONTINUE
C
C        COMPUTE FOR LATITUDE NORTH OF THETAM
C
         JC = JNV*IMP3 + 1
C
         CALL ANGUVR(JNV2M0, CPHV(JC), SPHV(JC), WK1(JC)
     *,              WK2(JC), PHO(JC), CBV(JC), SBV(JC), CP1(JC))
C
      ELSE
         DO 220 I=1,IJM1M0
         PHO(I) =  PHV(I) - WK2(I)
  220    CONTINUE
      ENDIF
C
C
      DO 250 I=1,IJM1M0
      BLO(I) = -WK1(I) + XCR(I)
      SGO(I) =  SGB - 0.25 * (SGI(I) + SGI(I1+I))
  250 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE ZANGUR(UIN, VIN, SGI
     *,                CPHU, SPHU, PHU, XCR, SGB, SIG
     *,                 PHO, BLO, SGO, CBV, SBV, CP2, WK1, WK2
     *,                 TX1,  TX2,  TX3)
C
#include "slgcm.slgprm"
C
C
      DIMENSION  UIN(IJM0M0),  VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),  BLO(IJM0M0), SGO(IJM0M0)
     *,          CPHU(IJM0M0), SPHU(IJM0M0), PHU(IJM0M0)
     *,          CBV(IJM0M0),  SBV(IJM0M0),  XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0),  CP2(IJM0M0)
     *,          TX1(IJP3M0),  TX2(IJP3M0),  TX3(IJP3M0)
C
C      COMPUTE V AT U-POINTS I.E. VUPT(I,J)
C
      CALL UPTV(IJM0M0, VIN, WK1, TX1, TX2, TX3, IJP3M0)
C
      DO 45 I=1,IJM1M0
      WK1(I) =  WK1(I) * 0.5
      WK2(I) =  UIN(I) * 0.5
   45 CONTINUE
C
      IF (ROTATE) THEN
C
C     COMPUTE FOR SOUTH OF THETAM
C
C
         JC = I1 + 1
         CALL ANGUVR(JSU2M0, CPHU(JC), SPHU(JC), WK2(JC)
     *,              WK1(JC), PHO(JC),  CBV(JC),  SBV(JC), CP2(JC))
C
         DO 50 I=1,JSU2M0
         CBV(I+I1) = CBV(I+I1) * CP2(I+I1)
         SBV(I+I1) = SBV(I+I1) * CP2(I+I1)
   50    CONTINUE
C
C        POINTS EQUATORWARD OF THETAM
C
         JN    = (JSU-1)*IMP3
C
         DO 55 I=1,JUP0M0
         PHO(JN+I) = PHU(JN+I) - WK1(JN+I)
   55    CONTINUE
C
C        NORTHERN HIGH LATITUDES (POLEWARD OF THETAM)
C
         JN = JNU*IMP3
         JC = JN + 1
C
         CALL ANGUVR(JNU2M0, CPHU(JC), SPHU(JC), WK2(JC)
     *,              WK1(JC), PHO(JC),  CBV(JC),  SBV(JC), CP2(JC))
C
         DO 60 I=1,JNU2M0
         CBV(JN+I) = CBV(JN+I) * CP2(JN+I)
         SBV(JN+I) = SBV(JN+I) * CP2(JN+I)
   60    CONTINUE
C
      ELSE
         DO 62 I=I1P1,IJM1M0
         PHO(I) = PHU(I) - WK1(I)
   62    CONTINUE
      ENDIF
C

      DO 65 I=1,IJM2M1
      WK1(I1+I)   = SGI(I1+I) + SGI(I1+I+1)
   65 CONTINUE
      DO 70 I=1,IJM0M0,IMP3
      WK1(IMP2+I)  = WK1(I+2)
   70 CONTINUE
C
      DO 75 I=I1P1,IJM1M0
      BLO(I) = xcr(I) - WK2(I)
      SGO(I) = SGB - WK1(I)*0.25
   75 CONTINUE
C
C
      RETURN
      END
      SUBROUTINE ZANGPR(UIN,  VIN,  SGI, FAC
     *,                CPHU, SPHU, PHU, XCR, SGB, SIG
     *,                PHO,  BLO,  SGO, CBV, SBV
     *,                CP2, WK1, WK2, WK3, WK4, WK5, WK6)
#include "slgcm.slgprm"
C
C
      DIMENSION  UIN(IJM0M0),  VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),  BLO(IJM0M0), SGO(IJM0M0)
     *,         CPHU(IJM0M0), SPHU(IJM0M0), PHU(IJM0M0), XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0), WK3(IJM0M0),  WK4(IJM0M0)
     *,          WK5(IJM0M0),  WK6(IJM0M0), CP2(IJM0M0)
     *,          CBV(IJM0M0),  SBV(IJM0M0)
C
C
C      FIRST COMPUTE U & V AT FI - POINTS
C
C AT J=2
C
      DO 10 I=1,IJM1M1
      WK1(I+1) = UIN(I+1) + UIN(I)
   10 CONTINUE
      DO 15 I=1,IJM1M0,IMP3
      WK1(I)   = WK1(IM+I)
   15 CONTINUE
      DO 20 I=1,IJM1M0
      WK2(I1+I) = VIN(I) + VIN(I1+I)
   20 CONTINUE
C
      DO 25 I=1,IMP3
      WK4(I1+I) = WK1(I1+I) * HALF
      WK3(I1+I) = WK2(I1+I) * HALF
   25 CONTINUE
C
C AT J=3,JMM2
C
      DO 30 I=1,IJM4M0
      WK5(I2+I) = VIN(I3+I) + VIN(I)
   30 CONTINUE
      DO 35 I=1,IJM4M3
      WK6(I2+I+2) = UIN(I2+I+3) + UIN(I2+I)
   35 CONTINUE
      DO 40 I=I2P1,IJM2M0,IMP3
      WK6(I)      = WK6(IM+I)
      WK6(I+1)    = WK6(IMP1+I)
      WK6(IMP2+I) = WK6(I+2)
   40 CONTINUE
C
C
      DO 45 I=1,IJM4M0
      WK3(I2+I) =  WK2(I2+I) * C9O16 - WK5(I2+I) * C1O16
      WK4(I2+I) =  WK1(I2+I) * C9O16 - WK6(I2+I) * C1O16
   45 CONTINUE
C
C AT J=JMM1
C
      DO 50 I=1,IMP3
      WK4(IJM2M0+I) = WK1(IJM2M0+I) * HALF
      WK3(IJM2M0+I) = WK2(IJM2M0+I) * HALF
   50 CONTINUE
C
      DO 55 I=1,IJM2M0
      WK4(I1+I) = WK4(I1+I) * FAC
      WK3(I1+I) = WK3(I1+I) * FAC
   55 CONTINUE
C
      IF (ROTATE) THEN
C
C     COMPUTE FOR SOUTH OF THETAM
C
         JC = I1 + 1
         CALL ANGUVR(JSU2M0, CPHU(JC), SPHU(JC), WK4(JC)
     *,              WK3(JC), PHO(JC),  CBV(JC),  SBV(JC), CP2(JC))
C
         DO 60 I=1,JSU2M0
         CBV(I+I1) = CBV(I+I1) * CP2(I+I1)
         SBV(I+I1) = SBV(I+I1) * CP2(I+I1)
   60    CONTINUE
C
C        POINTS EQUATORWARD OF THETAM
C
         JN    = (JSU-1) * IMP3
C
         DO 65 I=1,JUP0M0
         PHO(JN+I) = PHU(JN+I) - WK3(JN+I)
   65    CONTINUE
C
C        NORTHERN HIGH LATITUDES (POLEWARD OF THETAM)
C
         JN    = JNU*IMP3
         JC    = JN + 1
C
         CALL ANGUVR(JNU2M0, CPHU(JC), SPHU(JC), WK4(JC)
     *,              WK3(JC), PHO(JC),  CBV(JC),  SBV(JC), CP2(JC))
C
         DO 70 I=1,JNU2M0
         CBV(JN+I) = CBV(JN+I) * CP2(JN+I)
         SBV(JN+I) = SBV(JN+I) * CP2(JN+I)
   70    CONTINUE
      ELSE
         DO 75 I=I1P1,IJM1M0
         PHO(I) = PHU(I) - WK3(I)
   75    CONTINUE
      ENDIF
C
      DO 80 I=I1P1,IJM1M0
      BLO(I) = XCR(I) - WK4(I)
   80 CONTINUE
C
      DO 85 I=1,IJM0M0
      SGO(I) = SGB - SGI(I)*FAC
   85 CONTINUE
C
      RETURN
      END
      SUBROUTINE ZANGP(UIN,  VIN,  SGI, FAC
     *,                CPHU, SPHU, PHU, XCR, SGB, SIG
     *,                PHO,  BLO,  SGO, WK1, WK2)
#include "slgcm.slgprm"
C
C
      DIMENSION  UIN(IJM0M0),  VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),  BLO(IJM0M0), SGO(IJM0M0)
     *,         CPHU(IJM0M0), SPHU(IJM0M0), PHU(IJM0M0), XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0)
C
      DO 55 I=1,IJM2M0
      WK1(I1+I) = UIN(I1+I) * FAC
      WK2(I1+I) = VIN(I1+I) * FAC
   55 CONTINUE
C
      IF (ROTATE) THEN
C
C        COMPUTE FOR SOUTH OF THETAM
C
         JC = I1+1
         CALL ANGUVP(JSU2M0, CPHU(JC), SPHU(JC)
     *,                      WK1(JC),  WK2(JC), PHO(JC))
C
C         POINTS EQUATORWARD OF THETAM
C
         JN    = (JSU-1) * IMP3
C
         DO 60 I=1,JUP0M0
         PHO(JN+I) = PHU(JN+I) - WK2(JN+I)
   60    CONTINUE
C
C    NORTHERN HIGH LATITUDES (POLEWARD OF THETAM)
C
         JC    = JNU*IMP3 + 1
         CALL ANGUVP(JNU2M0, CPHU(JC), SPHU(JC)
     *,                      WK1(JC),  WK2(JC), PHO(JC))
      ELSE
         DO 62 I=I1P1,IJM1M0
         PHO(I) = PHU(I) - WK2(I)
   62    CONTINUE
      ENDIF
C
      DO 65 I=I1P1,IJM1M0
      BLO(I) = XCR(I) - WK1(I)
   65 CONTINUE
C
      DO 75 I=1,IJM0M0
      SGO(I) = SGB - SGI(I)*FAC
   75 CONTINUE
C
      RETURN
      END
      SUBROUTINE ZANGV(UIN,  VIN,  SGI, FAC
     *,                CPHV, SPHV, PHV, XCR, SGB, SIG
     *,                PHO,  BLO,  SGO, WK1, WK2)
#include "slgcm.slgprm"
C
      DIMENSION  UIN(IJM0M0),  VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),  BLO(IJM0M0), SGO(IJM0M0)
     *,         CPHV(IJM0M0), SPHV(IJM0M0), PHV(IJM0M0), XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0)
C
      DO 67 I=1,IJM1M0
      WK1(I) = UIN(I) * FAC
      WK2(I) = VIN(I) * FAC
   67 CONTINUE
C
      IF (ROTATE) THEN
C
C        COMPUTE FOR SOUTH OF THETAM
C
C        JC=3
         CALL ANGUVP(JSV1M0, CPHV, SPHV, WK1, WK2, PHO)
C
C        COMPUTE FOR THE EQUATORIAL POINTS
C
         JC = (JSV-1) * IMP3
C
         DO 70 I=1,JVP0M0
         PHO(I+JC) =  PHV(I+JC) - VIN(I+JC)
   70    CONTINUE
C
C        COMPUTE FOR LATITUDE NORTH OF THETAM
C
         JC=JNV * IMP3 + 1
         CALL ANGUVP(JNV2M0,  CPHV(JC), SPHV(JC)
     *,                       WK1(JC),  WK2(JC), PHO(JC))
      ELSE
         DO 72 I=1,IJM1M0
         PHO(I) =  PHV(I) - VIN(I)
   72    CONTINUE
      ENDIF
C
      DO 75 I=1,IJM1M0
      BLO(I) = -WK1(I) + XCR(I)
      SGO(I) =  SGB    - SGI(I) * FAC
   75 CONTINUE
C
      RETURN
      END
      SUBROUTINE ZANGU(UIN, VIN, SGI, FAC
     *,                CPHU, SPHU, PHU, XCR, SGB, SIG
     *,                PHO, BLO, SGO, WK1, WK2)
#include "slgcm.slgprm"
C
C
      DIMENSION  UIN(IJM0M0),   VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),   BLO(IJM0M0), SGO(IJM0M0)
     *,          CPHU(IJM0M0), SPHU(IJM0M0), PHU(IJM0M0), XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0)
C
C
      DO 42 I=1,IJM0M0
      WK1(I) = UIN(I) * FAC
      WK2(I) = VIN(I) * FAC
  42  CONTINUE
C
      IF (ROTATE) THEN
C
C        COMPUTE FOR SOUTH OF THETAM
C
         JC=I1 + 1
         CALL ANGUVP(JSU2M0,  CPHU(JC), SPHU(JC)
     *,                       WK1(JC),  WK2(JC), PHO(JC))
C
C         POINTS EQUATORWARD OF THETAM
C
         JN    = (JSU-1)*IMP3
C
         DO 45 I=1,JUP0M0
         PHO(JN+I) = PHU(JN+I) - WK2(JN+I)
   45    CONTINUE
C
C        NORTHERN HIGH LATITUDES (POLEWARD OF THETAM)
C
         JC=JNU * IMP3 + 1
         CALL ANGUVP(JNU2M0,  CPHU(JC), SPHU(JC)
     *,                       WK1(JC),  WK2(JC), PHO(JC))
      ELSE
         DO 46 I=I1P1,IJM1M0
         PHO(I) = PHU(I) - WK2(I)
   46    CONTINUE
      ENDIF
C
C
      DO 60 I=I1P1,IJM1M0
      BLO(I) = xcr(I) - UIN(I)
      SGO(I) = SGB - SGI(I)*FAC
   60 CONTINUE
C
      RETURN
      END
      SUBROUTINE ANGUVR(LEN, CPH, SPH, UIN, VIN, PHO, CBV, SBV, CPA)
C
      DIMENSION  PHO(LEN), CPH(LEN), SPH(LEN), CBV(LEN), SBV(LEN)
     *,          UIN(LEN), VIN(LEN), CPA(LEN)
C
C
      DO 10 I=1,LEN
      SINV   = SIN(-VIN(I))
      COSV   = COS(-VIN(I))
C
      SINU   = COSV * SIN(-UIN(I))
      COSU   = COSV * COS(-UIN(I))

      TEMA   = CPH(I) * SINV + SPH(I) * COSU
      TEMB   = CPH(I) * COSU - SPH(I) * SINV
C
      PHO(I) = ASIN(TEMA)
C
      UIN(I) = - ATAN2(SINU,TEMB)
C
      TEM    = SQRT(1.0 - TEMA*TEMA) * CPH(I)
     *       + SPH(I) * TEMA * COS(-UIN(I))
C
      CPA(I) =  1.0  /  COSV
      CBV(I) =  TEM  *  CPA(I)
C
      SBV(I) = SPH(I) * SIN(-UIN(I)) * CPA(I)
C
   10 CONTINUE
C
      RETURN
      END
      SUBROUTINE ANGUVP(LEN, CPH, SPH, UIN, VIN, PHO)
C
      DIMENSION  PHO(LEN), CPH(LEN), SPH(LEN), UIN(LEN), VIN(LEN)
C
      DO 10 I=1,LEN
      SINV   = SIN(-VIN(I))
      COSV   = COS(-VIN(I))
C
      SINU   = COSV * SIN(-UIN(I))
      COSU   = COSV * COS(-UIN(I))

      TEMA   = CPH(I) * SINV + SPH(I) * COSU
      TEMB   = CPH(I) * COSU - SPH(I) * SINV
C
      PHO(I) = ASIN(TEMA)
C
      UIN(I) = - ATAN2(SINU,TEMB)
   10 CONTINUE
C
      RETURN
      END
      SUBROUTINE ZNGPR2(UIN,  VIN,  SGI, FAC, VST, DTOA
     *,                CPHU, SPHU, PHU, XCR, SGB, SIG
     *,                PHO,  BLO,  SGO, CBV, SBV
     *,                CP2, WK1, WK2, WK3, WK4, WK5, WK6)
#include "slgcm.slgprm"
#include "slgcm.slgclm"
C
C
      DIMENSION  UIN(IJM0M0),  VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),  BLO(IJM0M0), SGO(IJM0M0), VST(IJM0M0)
     *,         CPHU(IJM0M0), SPHU(IJM0M0), PHU(IJM0M0), XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0), WK3(IJM0M0),  WK4(IJM0M0)
     *,          WK5(IJM0M0),  WK6(IJM0M0), CP2(IJM0M0)
     *,          CBV(IJM0M0),  SBV(IJM0M0)
     *,          CVV(2),       GLM00(2)
C
C
C      FIRST COMPUTE U & V AT FI - POINTS
C
C AT J=2
C
      DO 10 I=1,IJM1M1
      WK1(I+1) = UIN(I+1) + UIN(I)
   10 CONTINUE
      DO 15 I=1,IJM1M0,IMP3
      WK1(I)   = WK1(IM+I)
   15 CONTINUE
      DO 20 I=1,IJM1M0
      WK2(I1+I) = VIN(I) + VIN(I1+I)
   20 CONTINUE
C
      DO 25 I=1,IMP3
      WK4(I1+I) = WK1(I1+I) * HALF
      WK3(I1+I) = WK2(I1+I) * HALF
   25 CONTINUE
C
C AT J=3,JMM2
C
      DO 30 I=1,IJM4M0
      WK5(I2+I) = VIN(I3+I) + VIN(I)
   30 CONTINUE
      DO 35 I=1,IJM4M3
      WK6(I2+I+2) = UIN(I2+I+3) + UIN(I2+I)
   35 CONTINUE
      DO 40 I=I2P1,IJM2M0,IMP3
      WK6(I)      = WK6(IM+I)
      WK6(I+1)    = WK6(IMP1+I)
      WK6(IMP2+I) = WK6(I+2)
   40 CONTINUE
C
C
      DO 45 I=1,IJM4M0
      WK3(I2+I) =  WK2(I2+I) * C9O16 - WK5(I2+I) * C1O16
      WK4(I2+I) =  WK1(I2+I) * C9O16 - WK6(I2+I) * C1O16
   45 CONTINUE
C
C AT J=JMM1
C
      DO 50 I=1,IMP3
      WK4(IJM2M0+I) = WK1(IJM2M0+I) * HALF
      WK3(IJM2M0+I) = WK2(IJM2M0+I) * HALF
   50 CONTINUE
C
      DO 55 I=1,IJM2M0
      WK4(I1+I) = WK4(I1+I) * FAC
      WK3(I1+I) = WK3(I1+I) * FAC
   55 CONTINUE
C
      IF (ROTATE) THEN
C
C     COMPUTE FOR SOUTH OF THETAM
C
         JC = I1 + 1
         CALL ANGUVR(JSU2M0, CPHU(JC), SPHU(JC), WK4(JC)
     *,              WK3(JC), PHO(JC),  CBV(JC),  SBV(JC), CP2(JC))
C
         DO 60 I=1,JSU2M0
         CBV(I+I1) = CBV(I+I1) * CP2(I+I1)
         SBV(I+I1) = SBV(I+I1) * CP2(I+I1)
   60    CONTINUE
C
C        POINTS EQUATORWARD OF THETAM
C
         JN    = (JSU-1) * IMP3
C
         DO 65 I=1,JUP0M0
         PHO(JN+I) = PHU(JN+I) - WK3(JN+I)
   65    CONTINUE
C
C        NORTHERN HIGH LATITUDES (POLEWARD OF THETAM)
C
         JN    = JNU*IMP3
         JC    = JN + 1
C
         CALL ANGUVR(JNU2M0, CPHU(JC), SPHU(JC), WK4(JC)
     *,              WK3(JC), PHO(JC),  CBV(JC),  SBV(JC), CP2(JC))
C
         DO 70 I=1,JNU2M0
         CBV(JN+I) = CBV(JN+I) * CP2(JN+I)
         SBV(JN+I) = SBV(JN+I) * CP2(JN+I)
   70    CONTINUE
      ELSE
         DO 75 I=I1P1,IJM1M0
         PHO(I) = PHU(I) - WK3(I)
   75    CONTINUE
      ENDIF
C
      DO 80 I=I1P1,IJM1M0
      BLO(I) = XCR(I) - WK4(I)
   80 CONTINUE
C
      DO 85 I=1,IJM0M0
      SGO(I) = SGB - SGI(I)*FAC
c     IF (SGO(I) .LT. SIG(1)) SGO(I) = SIG(1)
c     IF (SGO(I) .GT. SIG(LM+1)) SGO(I) = SIG(LM+1)
   85 CONTINUE
C
C     FIND THE DEPARTURE POINT FOR THE POLES
C
      WK1(:) = VST(:) * 0.5
C
      CALL VPOLE (IM, DLM, TWOPI, TWOOIM, PI
     *,       WK1(1), CLM(1,2), SLM(1,2), CVV(1), GLM00(1))
C
      CALL VPOLE (IM, DLM, TWOPI, TWOOIM, ZERO
     *,      WK1(IJM2M0+1), CLM(1,2), SLM(1,2), CVV(2), GLM00(2))
C
      DO 90 I=1,IMP3
      BLO(I)        = GLM00(1)
      BLO(I+IJM1M0) = GLM00(2)
      PHO(I)        = CVV(1) * DTOA
      PHO(I+IJM1M0) = CVV(2) * DTOA
   90 CONTINUE
C
      RETURN
      END
      SUBROUTINE ZANGP2(UIN,  VIN,  SGI, FAC, VST, DTOA
     *,                CPHU, SPHU, PHU, XCR, SGB, SIG
     *,                PHO,  BLO,  SGO, WK1, WK2)
#include "slgcm.slgprm"
#include "slgcm.slgclm"
C
C
      DIMENSION  UIN(IJM0M0),  VIN(IJM0M0), SGI(IJM0M0), SIG(LM+1)
     *,          PHO(IJM0M0),  BLO(IJM0M0), SGO(IJM0M0), VST(IJM0M0)
     *,         CPHU(IJM0M0), SPHU(IJM0M0), PHU(IJM0M0), XCR(IJM0M0)
      DIMENSION  WK1(IJM0M0),  WK2(IJM0M0)
     *,          CVV(2),       GLM00(2)
C
      DO 55 I=1,IJM2M0
      WK1(I1+I) = UIN(I1+I) * FAC
      WK2(I1+I) = VIN(I1+I) * FAC
   55 CONTINUE
C
      IF (ROTATE) THEN
C
C        COMPUTE FOR SOUTH OF THETAM
C
         JC = I1+1
         CALL ANGUVP(JSU2M0, CPHU(JC), SPHU(JC)
     *,                      WK1(JC),  WK2(JC), PHO(JC))
C
C         POINTS EQUATORWARD OF THETAM
C
         JN    = (JSU-1) * IMP3
C
         DO 60 I=1,JUP0M0
         PHO(JN+I) = PHU(JN+I) - WK2(JN+I)
   60    CONTINUE
C
C    NORTHERN HIGH LATITUDES (POLEWARD OF THETAM)
C
         JC    = JNU*IMP3 + 1
         CALL ANGUVP(JNU2M0, CPHU(JC), SPHU(JC)
     *,                      WK1(JC),  WK2(JC), PHO(JC))
      ELSE
         DO 62 I=I1P1,IJM1M0
         PHO(I) = PHU(I) - WK2(I)
   62    CONTINUE
      ENDIF
C
      DO 65 I=I1P1,IJM1M0
      BLO(I) = XCR(I) - WK1(I)
   65 CONTINUE
C
      DO 75 I=1,IJM0M0
      SGO(I) = SGB - SGI(I)*FAC
c     IF (SGO(I) .LT. SIG(1)) SGO(I) = SIG(1)
c     IF (SGO(I) .GT. SIG(LM+1)) SGO(I) = SIG(LM+1)
   75 CONTINUE
C
C     FIND THE DEPARTURE POINT FOR THE POLES
C
      CALL VPOLE (IM, DLM, TWOPI, TWOOIM, PI
     *,       VST(1), CLM(1,2), SLM(1,2), CVV(1), GLM00(1))
C
      CALL VPOLE (IM, DLM, TWOPI, TWOOIM, ZERO
     *,      VST(IJM2M0+1), CLM(1,2), SLM(1,2), CVV(2), GLM00(2))
C
      DO 80 I=1,IMP3
      BLO(I)        = GLM00(1)
      BLO(I+IJM1M0) = GLM00(2)
      PHO(I)        = CVV(1) * DTOA
      PHO(I+IJM1M0) = CVV(2) * DTOA
   80 CONTINUE
C
      RETURN
      END
      SUBROUTINE PZN4PT(LEN, FIN, FOU, WK1, WK2)
C
#include "slgcm.slgprm"
C
      DIMENSION FIN(LEN), FOU(LEN), WK1(LEN), WK2(LEN)
C
      DO 10 I=I1P1,IJM1M1
      WK1(I+1) = FIN(I+1) + FIN(I)
   10 CONTINUE 
C
      DO 15 I=I1P1,IJM1M0,IMP3
      WK1(I)   = WK1(IM+I)
   15 CONTINUE
C
      DO 20 I=I1P1,IJM1M3
      WK2(I+2) = FIN(I+3) + FIN(I)
   20 CONTINUE
C
      DO 40 I=I1P1,IJM1M0,IMP3
      WK2(I)      = WK2(IM+I)
      WK2(I+1)    = WK2(IMP1+I)
      WK2(IMP2+I) = WK2(I+2)
   40 CONTINUE
C
      DO 50 I=I1P1,IJM1M0
      FOU(I) = WK1(I) * C9O16 - WK2(I) * C1O16
   50 CONTINUE
C
      RETURN
      END
      SUBROUTINE UZN4PT(LEN, FIN, FOU, WK1, WK2)
C
#include "slgcm.slgprm"
C
      DIMENSION FIN(LEN), FOU(LEN), WK1(LEN), WK2(LEN)
C
      DO 10 I=I1P1,IJM1M1
      WK1(I) = FIN(I+1) + FIN(I)
   10 CONTINUE 
C
      DO 15 I=I1P1,IJM1M0,IMP3
      WK1(IMP2+I) = WK1(I)
   15 CONTINUE
C
      DO 20 I=I1P1,IJM1M3
      WK2(I+1) = FIN(I+3) + FIN(I)
   20 CONTINUE
C
      DO 40 I=I1P1,IJM1M0,IMP3
      WK2(I)      = WK2(IM+I)
      WK2(IMP1+I) = WK2(I+1)
      WK2(IMP2+I) = WK2(I+2)
   40 CONTINUE
C
      DO 50 I=I1P1,IJM1M0
      FOU(I) = WK1(I) * C9O16 - WK2(I) * C1O16
C     FOU(I) = WK1(I) * 0.5
   50 CONTINUE
C
      RETURN
      END
      SUBROUTINE PMR4PT(LEN, FIN, FOU, TX1, LENP)
C
#include "slgcm.slgprm"
C
      DIMENSION FIN(LEN), FOU(LEN), TX1(LENP)
C
      DO 10 I=1,IJM0M0
      TX1(I2+I) = FIN(I)
   10 CONTINUE
C
      CALL FILLV(TX1)
C
      DO 20 I=1,IJM0M0
      FOU(I) = (TX1(I1+I) + TX1(I2+I)) * C9O16
     *       - (TX1(   I) + TX1(I3+I)) * C1O16
   20 CONTINUE
C
      RETURN
      END
      SUBROUTINE VMR4PT(LEN, FIN, FOU, TX1, LENP)
C
#include "slgcm.slgprm"
C
      DIMENSION FIN(LEN), FOU(LEN), TX1(LENP)
C
      DO 10 I=1,IJM0M0
      TX1(I2+I) = FIN(I)
   10 CONTINUE
C
      CALL FILLP(TX1)
C
      DO 20 I=1,IJM1M0
      FOU(I) = (TX1(I2+I) + TX1(I3+I)) * C9O16
     *       - (TX1(I1+I) + TX1(I4+I)) * C1O16
C     FOU(I) = (TX1(I2+I) + TX1(I3+I)) * 0.5
   20 CONTINUE
C
      RETURN
      END
      SUBROUTINE VPTU(LEN, UIN, UOU, TX1, TX2, TX3, LENP)
C
#include "slgcm.slgprm"
C
      DIMENSION UIN(LEN), UOU(LEN) 
     *,         TX1(LENP), TX2(LENP), TX3(LENP)
C
C      COMPUTE U AT V-POINTS I.E. UVPT(I,J)
C
C
      DO 10 I=1,IJM0M0
      TX3(I2+I) = UIN(I)
   10 CONTINUE
      CALL FILLU(TX3)
C
      DO 12 I=1,IJP3M0,IMP3
      TX3(IM  +I) = TX3(I)
      TX3(IMP1+I) = TX3(I+1)
      TX3(IMP2+I) = TX3(I+2)
   12 CONTINUE
c
      DO 15 I=1,IJP2M1
      TX1(I1+I+1)  = TX3(I1+I+1) + TX3(I1+I)
   15 CONTINUE
      DO 17 I=I1P1,IJP3M0,IMP3
      TX1(I)   = TX1(IM+I)
   17 CONTINUE

      IF (FOURPT) THEN
         DO 40 I=1,IJM1M0
         UOU(I   )     = (TX1(I2+I)     + TX1(I3+I)) * 0.25
   40    CONTINUE
      ELSE
         DO 20 I=1,IJP2M3
         TX2(I1+I+2)  = TX3(I1+I+3) + TX3(I1+I)
   20    CONTINUE
         DO 25 I=I1P1,IJP3M0,IMP3
         TX2(I)      = TX2(IM+I)
         TX2(I+1)    = TX2(IM+I+1)
         TX2(IM+I+2) = TX2(I+2)
   25    CONTINUE
         DO 50 I=1,IJM1M0
         UOU(I)  = (TX1(I3+I)  + TX1(I2+I)) * C81
     *           + (TX2(I1+I)  + TX2(I4+I)) * C01
     *           - (TX2(I3+I)  + TX2(I2+I) + TX1(I4+I) + TX1(I1+I))*C09
   50    CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE UPTV(LEN, VIN, VOU, TX1, TX2, TX3, LENP)
C
#include "slgcm.slgprm"
C
      DIMENSION VIN(LEN), VOU(LEN) 
     *,         TX1(LENP), TX2(LENP), TX3(LENP)
C
C     COMPUTE V AT U-POINTS I.E. VUPT(I,J)
C
      DO 10 I=1,IJM0M0
      TX3(I2+I) = VIN(I)
   10 CONTINUE
C
      CALL FILLV(TX3)
C
      DO 12 I=1,IJP3M0,IMP3
      TX3(IM  +I) = TX3(I)
      TX3(IMP1+I) = TX3(I+1)
      TX3(IMP2+I) = TX3(I+2)
   12 CONTINUE
C
      DO 20 I=1,IJP3M1
      TX1(I) = TX3(I+1) + TX3(I)
   20 CONTINUE
      DO 22 I=1,IJP3M0,IMP3
      TX1(IM+I+2) = TX1(I+2)
   22 CONTINUE
      IF (FOURPT) THEN
         DO 37 I=1,IJM1M0
         VOU(I1+I  )   = (TX1(I2+I )    + TX1(I3+I))     * 0.25
   37    CONTINUE
      ELSE
         DO 25 I=1,IJP3M3
         TX2(I+1) = TX3(I+3) + TX3(I)
   25    CONTINUE
         DO 30 I=1,IJP3M0,IMP3
         TX2(I)      = TX2(IM+I)
         TX2(IM+I+1) = TX2(I+2)
         TX2(IM+I+2) = TX2(I+3)
   30    CONTINUE
         DO 40 I=1,IJM1M0
         VOU(I) = (TX1(I2+I) + TX1(I1+I)) * C81
     *          + (TX2(I)    + TX2(I3+I)) * C01
     *          - (TX2(I2+I) + TX2(I1+I) + TX1(I3+I) + TX1(I)) * C09
   40    CONTINUE
      ENDIF
C
      RETURN
      END

