w3ft26.f

Go to the documentation of this file.

C> @file
C                .      .    .                                       .
C> SUBPROGRAM:   W3FT26       CREATES WAFS 1.25X1.25 THINNED GRIDS
C>   PRGMMR: FARLEY           ORG: W/NMC42    DATE: 93-04-28
C>
C> ABSTRACT: 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>   93-04-28  FARLEY      ORIGINAL AUTHOR
C>   94-04-01  R.E.JONES   CORRECTIONS FOR 1 DEG. DISPLACEMENT
C>                         OF GRIDS AND ERROR IN FLIPPING OF
C>                         SOUTHERN HEMISPHERE.
C>   94-05-05  R.E.JONES   REPLACE SUBR. W3FT01 WITH W3FT16 AND W3FT17.
C>   94-06-04  R.E.JONES   CHANGE SUBROUTINE NAME FROM WFSTRP TO W3FT26
C>
C> USAGE:  CALL W3FT26 (MAPNUM,FLD,HI,IGPTS,NSTOP)
C>   INPUT ARGUMENT LIST:
C>     MAPNUM   -  NUMBER OF GRID, 37 TO 44
C>     FLD      -  NORTHERN OR SOUTHERN HEM. SPECTRAL FIELD
C>
C>   OUTPUT ARGUMENT LIST:
C>     HI       - INTERPOLATED WAFS FIELD (3447 POINTS)
C>     IGPTS    - NUMBER OF POINTS IN INTERPOLATED FIELD
C>     NSTOP    - 24, WHEN MAPNUM .NE. 37 THRU 44
C>
C>   SUBPROGRAMS CALLED:       
C>     LIBRARY:                                                      
C>       W3LIB    - W3FT16, W3FT17                                   
C>
C> ATTRIBUTES:
C>   LANGUAGE: CRAY CFT77 FORTRAN
C>   MACHINE:  CRAY C916-128, CRAY Y-MP8/864, CRAY Y-MP EL2/256
C>
      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