w3ft26.f

Go to the documentation of this file.

C> @file
C> @brief Creates wafs 1.25x1.25 thinned grids.
C> @author Farley @date 1993-04-28
 
C> Converts a 360x181 1-degree grid into a nh or sh
C> 360x91 1-degree grid. This nh/sh grid is flipped for grib
C> purposes and then converted to the desired 1.25 degree
C> wafs (quadrant) thinned grid.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1993-04-28 | FARLEY | Original author.
C> 1994-04-01 | Ralph Jones | Corrections for 1 deg. displacement of grids and
C> error in flipping of southern hemisphere.
C> 1994-05-05 | Ralph Jones | Replace subr. w3ft01() with w3ft16() and w3ft17().
C> 1994-06-04 | Ralph Jones | Change subroutine name from wfstrp to w3ft26().
C>
C> @param[in] MAPNUM Number of grid, 37 to 44.
C> @param[in] FLD Northern or southern hem. spectral field.
C> @param[in] HI Interpolated wafs field (3447 points)
C> @param[in] IGPTS Number of points in interpolated field
C> @param[in] NSTOP 24, when mapnum .ne. 37 thru 44
C>
C> @author Farley @date 1993-04-28
      SUBROUTINE w3ft26 (MAPNUM,FLD,HI,IGPTS,NSTOP)
C
      REAL    FLD   (360,181)
      REAL    HALF  (360,91)
      REAL    HI    (3447)
      REAL    QUAD  (95,91)
C
      INTEGER IGPTS
      INTEGER MAPNUM
      INTEGER NSTOP
C
      SAVE
C
C     PRINT *,'   MADE IT TO W3FT26'
      nstop = 0
C
C             1.0    CUT FULL GRID TO DESIRED HEMISPHERE.
C
C             1.1    EXTRACT THE NORTHERN HEMISPHERE AND FLIP IT.
C
      IF (mapnum .EQ. 37  .OR.  mapnum .EQ. 38   .OR.
     &    mapnum .EQ. 39  .OR.  mapnum .EQ. 40)  THEN
        DO j=1,91
          DO i=1,360
            half(i,91-j+1) = fld(i,j)
          END DO
        END DO
C
C             1.2    EXTRACT THE SOUTHERN HEMISPHERE AND FLIP IT.
C
      ELSE IF (mapnum .EQ. 41  .OR.  mapnum .EQ. 42   .OR.
     &         mapnum .EQ. 43  .OR.  mapnum .EQ. 44)  THEN
        DO j=91,181
          DO i=1,360
            half(i,181-j+1) = fld(i,j)
          END DO
        END DO
      ENDIF
C
C             2.0    SELECT THE QUADRANT DESIRED.
C
      IF (mapnum .EQ. 37  .OR.  mapnum .EQ. 41) THEN
        DO 372 j = 1,91
          DO 370 i = 329,360
            quad(i-328,j) = half(i,j)
  370     CONTINUE
          DO 371 i = 1,63
            quad(i+32,j) = half(i,j)
  371     CONTINUE
  372   CONTINUE
C
      ELSE IF (mapnum .EQ. 38  .OR.  mapnum .EQ. 42) THEN
        DO 381 j = 1,91
          DO 380 i = 59,153
            quad(i-58,j) = half(i,j)
  380     CONTINUE
  381   CONTINUE
C
      ELSE IF (mapnum .EQ. 39  .OR.  mapnum .EQ. 43) THEN
        DO 391 j = 1,91
          DO 390 i = 149,243
            quad(i-148,j) = half(i,j)
  390     CONTINUE
  391   CONTINUE
C
      ELSE IF (mapnum .EQ. 40  .OR.  mapnum .EQ. 44) THEN
        DO 401 j = 1,91
          DO 400 i = 239,333
            quad(i-238,j) = half(i,j)
  400     CONTINUE
  401   CONTINUE
C
      ELSE
        print *,' W3FT26 - MAP NOT TYPE 37-44'
        igpts = 0
        nstop = 24
        RETURN
      ENDIF
C
      interp = 0
C
      IF (mapnum .EQ. 37  .OR.  mapnum .EQ. 38  .OR.
     &    mapnum .EQ. 39  .OR.  mapnum .EQ. 40) THEN
        CALL w3ft16(quad,hi,interp)
      ELSE
        CALL w3ft17(quad,hi,interp)
      ENDIF
C
      igpts = 3447
C
      RETURN
      END