      SUBROUTINE W3FT06V(ALOLA,APOLA,INTERP)
C$$$  SUBROUTINE DOCUMENTATION BLOCK  ***
C
C SUBROUTINE: W3FT06V   CONVERT (145,37) GRID TO (65,65) S. HEMI. GRID
C   AUTHOR:  JONES,R.E.        ORG:  W342         DATE: 85-04-10
C
C ABSTRACT:  CONVERT A SOUTHERN HEMISPHERE 2.5 DEGREE LAT.,LON. 145 BY
C   37 GRID TO A POLAR STEREOGRAPHIC 65 BY 65 GRID. THE POLAR
C   STEREOGRAPHIC MAP PROJECTION IS TRUE AT 60 DEG. S. , THE MESH
C   LENGTH IS 381 KM. AND THE ORIENTION IS 260 DEG. W.
C
C PROGRAM HISTORY LOG:
C   85-04-10  R.E.JONES   VECTORIZED VERSION OF W3FT05
C   89-10-21  R.E.JONES   CHANGES TO INCREASE SPEED
C   91-07-24  R.E.JONES   CHANGE  TO CRAY CFT77 FORTRAN
C   93-05-31  R.E.JONES   RECOMPILE SO LINEAR INTERPOLATION WORKS
C
C USAGE:  CALL W3FT06V(ALOLA,APOLA,INTERP)
C
C   INPUT ARGUMENTS:  ALOLA  - 145*37 GID 2.5 LAT,LON GRID S. HEMISHERE
C                              5365 POINT GRID IS O.N.84 TYPE 30 OR 1E HEX
C                     INTERP - 1 LINEAR INTERPOLATION , NE.1 BIQUADRATIC
C
C   INPUT FILES:  NONE
C
C   OUTPUT ARGUMENTS: APOLA - 65*65 GRID OF NORTHERN HEMI.
C                             4225 POINT GRID IS O.N.84 TYPE 28 OR 1C HEX
C
C   OUTPUT FILES: ERROR MESSAGE TO FORTRAN OUTPUT FILE
C
C   WARNINGS:
C
C   1. W1 AND W2 ARE USED TO STORE SETS OF CONSTANTS WHICH ARE
C   REUSABLE FOR REPEATED CALLS TO THE SUBROUTINE.
C
C   2. WIND COMPONENTS ARE NOT ROTATED TO THE 65*65 GRID ORIENTATION
C   AFTER INTERPOLATION. YOU MAY USE W3FC10 TO DO THIS.
C
C   3. THE GRID POINTS VALUES ON THE EQUATOR HAVE BEEN EXTRAPOLATED
C   OUTWARD TO ALL THE GRID POINTS OUTSIDE THE EQUATOR ON THE 65*65
C   GRID (ABOUT 1100 POINTS).
C
C   RETURN CONDITIONS: NORMAL SUBROUTINE EXIT
C
C   SUBPROGRAMS CALLED:
C     UNIQUE :  NONE
C
C     LIBRARY:  ASIN , ATAN2
C
C ATTRIBUTES:
C   LANGUAGE: CRAY CFT77 FORTRAN
C   MACHINE:  CRAY Y-MP8/864
C
C$$$
C
       REAL        R2(4225),      WLON(4225)
       REAL        XLAT(4225),    XI(65,65),   XJ(65,65)
       REAL        XII(4225),     XJJ(4225),   ANGLE(4225)
       REAL        ALOLA(145,37), APOLA(4225), ERAS(4225,4)
       REAL        W1(4225),      W2(4225)
       REAL        XDELI(4225),   XDELJ(4225)
       REAL        XI2TM(4225),   XJ2TM(4225)
C
       INTEGER     IV(4225),      JV(4225),    JY(4225,4)
       INTEGER     IM1(4225),     IP1(4225),   IP2(4225)
C
       LOGICAL     LIN
C
       SAVE
C
       EQUIVALENCE (XI(1,1),XII(1)),(XJ(1,1),XJJ(1))
C
       DATA  DEGPRD/57.2957795/
       DATA  EARTHR/6371.2/
       DATA  INTRPO/99/
       DATA  ISWT  /0/
C
      LIN = .FALSE.
      IF (INTERP.EQ.1) LIN = .TRUE.
      IF  (ISWT.EQ.1)  GO TO  900
C
        ORIENT = 260.0
        DEG    = 2.5
        XMESH  = 381.0
        GI2    = (1.86603 * EARTHR) / XMESH
        GI2    = GI2 * GI2
C
C     NEXT 32 LINES OF CODE PUTS SUBROUTINE W3FB03 IN LINE
C
      DO 100 J = 1,65
         XJ1 = J - 33
         DO 100 I = 1,65
             XI(I,J) = I - 33
             XJ(I,J) = XJ1
 100     CONTINUE
C
      DO 200 KK = 1,4225
        R2(KK)   = XJJ(KK) * XJJ(KK) + XII(KK) * XII(KK)
        XLAT(KK) = -DEGPRD *
     &      ASIN((GI2 - R2(KK)) / (GI2 + R2(KK)))
 200  CONTINUE
C
      XII(2113) = 1.0
      DO 300 KK = 1,4225
        ANGLE(KK) = DEGPRD * ATAN2(XJJ(KK),XII(KK))
 300  CONTINUE
C
      DO 400 KK = 1,4225
        IF (ANGLE(KK).LT.0.0) ANGLE(KK) = ANGLE(KK) + 360.0
 400  CONTINUE
C
      DO 500 KK = 1,4225
        WLON(KK) = ANGLE(KK) + ORIENT - 270.0
 500  CONTINUE
C
      DO 600 KK = 1,4225
        IF (WLON(KK).GE.360.0) WLON(KK) = WLON(KK) - 360.0
 600  CONTINUE
C
      DO 700 KK = 1,4225
        IF (WLON(KK).LT.0.0)   WLON(KK) = WLON(KK) + 360.0
 700  CONTINUE
C
      XLAT(2113) = -90.0
      WLON(2113) =   0.0
C
      DO 800 KK = 1,4225
        W1(KK)  = (360.0 - WLON(KK)) / DEG + 1.0
        W2(KK)  = (XLAT(KK) + 90.0)  / DEG + 1.0
 800  CONTINUE
C
      ISWT   = 1
      INTRPO = INTERP
      GO TO 1000
C
C     AFTER THE 1ST CALL TO W3FT05 TEST INTERP, IF IT HAS
C     CHANGED RECOMPUTE SOME CONSTANTS
C
  900 CONTINUE
        IF (INTERP.EQ.INTRPO) GO TO 2100
        INTRPO = INTERP
C
 1000 CONTINUE
        DO 1100 K = 1,4225
          IV(K)    = W1(K)
          JV(K)    = W2(K)
          XDELI(K) = W1(K) - IV(K)
          XDELJ(K) = W2(K) - JV(K)
          IP1(K)   = IV(K) + 1
          JY(K,3)  = JV(K) + 1
          JY(K,2)  = JV(K)
 1100   CONTINUE
C
      IF (LIN) GO TO 1400
C
      DO 1200 K = 1,4225
        IP2(K)   = IV(K) + 2
        IM1(K)   = IV(K) - 1
        JY(K,1)  = JV(K) - 1
        JY(K,4)  = JV(K) + 2
        XI2TM(K) = XDELI(K) * (XDELI(K) - 1.0) * .25
        XJ2TM(K) = XDELJ(K) * (XDELJ(K) - 1.0) * .25
 1200 CONTINUE
C
      DO 1300 KK = 1,4225
         IF (IV(KK).EQ.1) THEN
           IP2(KK) = 3
           IM1(KK) = 144
         ELSE IF (IV(KK).EQ.144) THEN
           IP2(KK) = 2
           IM1(KK) = 143
         ENDIF
 1300 CONTINUE
C
 1400 CONTINUE
C
      IF (LIN) GO TO 1700
C
      DO 1500 KK = 1,4225
        IF (JV(KK).LT.2.OR.JV(KK).GT.35) XJ2TM(KK) = 0.0
 1500 CONTINUE
C
      DO 1600 KK = 1,4225
        IF (IP2(KK).LT.1)   IP2(KK) = 1
        IF (IM1(KK).LT.1)   IM1(KK) = 1
        IF (IP2(KK).GT.145) IP2(KK) = 145
        IF (IM1(KK).GT.145) IM1(KK) = 145
 1600 CONTINUE
C
 1700 CONTINUE
      DO 1800 KK = 1,4225
        IF (IV(KK).LT.1)    IV(KK)  = 1
        IF (IP1(KK).LT.1)   IP1(KK) = 1
        IF (IV(KK).GT.145)  IV(KK)  = 145
        IF (IP1(KK).GT.145) IP1(KK) = 145
 1800 CONTINUE
C
C     LINEAR INTERPOLATION
C
      DO 1900 KK = 1,4225
        IF (JY(KK,2).LT.1)  JY(KK,2) = 1
        IF (JY(KK,2).GT.37) JY(KK,2) = 37
        IF (JY(KK,3).LT.1)  JY(KK,3) = 1
        IF (JY(KK,3).GT.37) JY(KK,3) = 37
 1900 CONTINUE
C
      IF (.NOT.LIN) THEN
      DO 2000 KK = 1,4225
        IF (JY(KK,1).LT.1)  JY(KK,1) = 1
        IF (JY(KK,1).GT.37) JY(KK,1) = 37
        IF (JY(KK,4).LT.1)  JY(KK,4) = 1
        IF (JY(KK,4).GT.37) JY(KK,4) = 37
 2000 CONTINUE
      ENDIF
C
 2100 CONTINUE
      IF (LIN) THEN
C
C     LINEAR INTERPOLATION
C
      DO 2200 KK = 1,4225
        ERAS(KK,2) = (ALOLA(IP1(KK),JY(KK,2))-ALOLA(IV(KK),JY(KK,2)))
     &             * XDELI(KK) + ALOLA(IV(KK),JY(KK,2))
        ERAS(KK,3) = (ALOLA(IP1(KK),JY(KK,3))-ALOLA(IV(KK),JY(KK,3)))
     &             * XDELI(KK) + ALOLA(IV(KK),JY(KK,3))
 2200 CONTINUE
C
      DO 2300 KK = 1,4225
        APOLA(KK) = ERAS(KK,2) + (ERAS(KK,3) - ERAS(KK,2))
     &            * XDELJ(KK)
 2300 CONTINUE
C
      ELSE
C
C     QUADRATIC INTERPOLATION
C
      DO 2400 KK = 1,4225
        ERAS(KK,1)=(ALOLA(IP1(KK),JY(KK,1))-ALOLA(IV(KK),JY(KK,1)))
     &            * XDELI(KK) + ALOLA(IV(KK),JY(KK,1)) +
     &            ( ALOLA(IM1(KK),JY(KK,1)) - ALOLA(IV(KK),JY(KK,1))
     &            - ALOLA(IP1(KK),JY(KK,1))+ALOLA(IP2(KK),JY(KK,1)))
     &            * XI2TM(KK)
        ERAS(KK,2)=(ALOLA(IP1(KK),JY(KK,2))-ALOLA(IV(KK),JY(KK,2)))
     &            * XDELI(KK) + ALOLA(IV(KK),JY(KK,2)) +
     &            ( ALOLA(IM1(KK),JY(KK,2)) - ALOLA(IV(KK),JY(KK,2))
     &            - ALOLA(IP1(KK),JY(KK,2))+ALOLA(IP2(KK),JY(KK,2)))
     &            * XI2TM(KK)
        ERAS(KK,3)=(ALOLA(IP1(KK),JY(KK,3))-ALOLA(IV(KK),JY(KK,3)))
     &            * XDELI(KK) + ALOLA(IV(KK),JY(KK,3)) +
     &            ( ALOLA(IM1(KK),JY(KK,3)) - ALOLA(IV(KK),JY(KK,3))
     &            - ALOLA(IP1(KK),JY(KK,3))+ALOLA(IP2(KK),JY(KK,3)))
     &            * XI2TM(KK)
        ERAS(KK,4)=(ALOLA(IP1(KK),JY(KK,4))-ALOLA(IV(KK),JY(KK,4)))
     &            * XDELI(KK) + ALOLA(IV(KK),JY(KK,4)) +
     &            ( ALOLA(IM1(KK),JY(KK,4)) - ALOLA(IV(KK),JY(KK,4))
     &            - ALOLA(IP1(KK),JY(KK,4))+ALOLA(IP2(KK),JY(KK,4)))
     &            * XI2TM(KK)
 2400      CONTINUE
C
       DO 2500 KK = 1,4225
         APOLA(KK) = ERAS(KK,2) + (ERAS(KK,3) - ERAS(KK,2))
     &             * XDELJ(KK)  + (ERAS(KK,1) - ERAS(KK,2)
     &             - ERAS(KK,3) + ERAS(KK,4)) * XJ2TM(KK)
 2500  CONTINUE
C
      ENDIF
C
C     SET POLE POINT , WMO STANDARD FOR U OR V
C
      APOLA(2113) = ALOLA(73,1)
C
      RETURN
      END
