r63w72.f

Go to the documentation of this file.

C> @file
C> @brief Convert w3fi63() parms to w3fi72() parms.
C> @author Mark Iredell @date 1992-10-31
 
C> Determines the integer PDS and GDS parameters
C> for the GRIB1 packing routine w3fi72() given the parameters
C> returned from the GRIB1 unpacking routine w3fi63().
C>
C> Program history log:
C> - Mark Iredell 1991-10-31
C> - Mark Iredell 1996-05-03 Corrected some level types and
C> some data representation types
C> - Mark Iredell 1997-02-14 Only altered ipds(26:27) for extended pds
C> - Chris Caruso 1998-06-01 Y2K fix for year of century
C> - Diane Stoken 2005-05-06 Recognize level 236
C>
C> @note kgds and igds extend beyond their dimensions here
C> if pl parameters are present.
C>
C> @param[in] kpds integer (200) PDS parameters from w3fi63().
C> @param[in] kgds integer (200) GDS parameters from w3fi63().
C> @param[out] ipds integer (200) PDS parameters for w3fi72().
C> @param[out] igds integer (200) GDS parameters for w3fi72().
C>
C> @author Mark Iredell @date 1992-10-31
      SUBROUTINE r63w72(KPDS,KGDS,IPDS,IGDS)
      dimension kpds(200),kgds(200),ipds(200),igds(200)
 
C  DETERMINE PRODUCT DEFINITION SECTION (PDS) PARAMETERS
      IF(kpds(23).NE.2) THEN
        ipds(1)=28                      ! LENGTH OF PDS
      ELSE
        ipds(1)=45                      ! LENGTH OF PDS
      ENDIF
      ipds(2)=kpds(19)                  ! PARAMETER TABLE VERSION
      ipds(3)=kpds(1)                   ! ORIGINATING CENTER
      ipds(4)=kpds(2)                   ! GENERATING MODEL
      ipds(5)=kpds(3)                   ! GRID DEFINITION
      ipds(6)=mod(kpds(4)/128,2)        ! GDS FLAG
      ipds(7)=mod(kpds(4)/64,2)         ! BMS FLAG
      ipds(8)=kpds(5)                   ! PARAMETER INDICATOR
      ipds(9)=kpds(6)                   ! LEVEL TYPE
      IF(kpds(6).EQ.101.OR.kpds(6).EQ.104.OR.kpds(6).EQ.106.OR.
     &   kpds(6).EQ.108.OR.kpds(6).EQ.110.OR.kpds(6).EQ.112.OR.
     &   kpds(6).EQ.114.OR.kpds(6).EQ.116.OR.kpds(6).EQ.121.OR.
     &   kpds(6).EQ.128.OR.kpds(6).EQ.141.OR.kpds(6).EQ.236)  THEN
        ipds(10)=mod(kpds(7)/256,256)   ! LEVEL VALUE 1
        ipds(11)=mod(kpds(7),256)       ! LEVEL VALUE 2
      ELSE
        ipds(10)=0                      ! LEVEL VALUE 1
        ipds(11)=kpds(7)                ! LEVEL VALUE 2
      ENDIF
      ipds(12)=kpds(8)                  ! YEAR OF CENTURY
      ipds(13)=kpds(9)                  ! MONTH
      ipds(14)=kpds(10)                 ! DAY
      ipds(15)=kpds(11)                 ! HOUR
      ipds(16)=kpds(12)                 ! MINUTE
      ipds(17)=kpds(13)                 ! FORECAST TIME UNIT
      ipds(18)=kpds(14)                 ! TIME RANGE 1
      ipds(19)=kpds(15)                 ! TIME RANGE 2
      ipds(20)=kpds(16)                 ! TIME RANGE INDICATOR
      ipds(21)=kpds(17)                 ! NUMBER IN AVERAGE
      ipds(22)=kpds(20)                 ! NUMBER MISSING IN AVERAGE
      ipds(23)=kpds(21)                 ! CENTURY
      ipds(24)=kpds(23)                 ! SUBCENTER
      ipds(25)=kpds(22)                 ! DECIMAL SCALING
      IF(ipds(1).GT.28) THEN
        ipds(26)=0                      ! PDS BYTE 29
        ipds(27)=0                      ! PDS BYTE 30
      ENDIF
 
C  DETERMINE GRID DEFINITION SECTION (GDS) PARAMETERS
      igds(1)=kgds(19)                  ! NUMBER OF VERTICAL COORDINATES
      igds(2)=kgds(20)                  ! VERTICAL COORDINATES
      igds(3)=kgds(1)                   ! DATA REPRESENTATION
      igds(4)=kgds(2)                   ! (UNIQUE TO REPRESENTATION)
      igds(5)=kgds(3)                   ! (UNIQUE TO REPRESENTATION)
      igds(6)=kgds(4)                   ! (UNIQUE TO REPRESENTATION)
      igds(7)=kgds(5)                   ! (UNIQUE TO REPRESENTATION)
      igds(8)=kgds(6)                   ! (UNIQUE TO REPRESENTATION)
      igds(9)=kgds(7)                   ! (UNIQUE TO REPRESENTATION)
      igds(10)=kgds(8)                  ! (UNIQUE TO REPRESENTATION)
      igds(11)=kgds(9)                  ! (UNIQUE TO REPRESENTATION)
      igds(12)=kgds(10)                 ! (UNIQUE TO REPRESENTATION)
      igds(13)=kgds(11)                 ! (UNIQUE TO REPRESENTATION)
      igds(14)=kgds(12)                 ! (UNIQUE TO REPRESENTATION)
      igds(15)=kgds(13)                 ! (UNIQUE TO REPRESENTATION)
      igds(16)=kgds(14)                 ! (UNIQUE TO REPRESENTATION)
      igds(17)=kgds(15)                 ! (UNIQUE TO REPRESENTATION)
      igds(18)=kgds(16)                 ! (UNIQUE TO REPRESENTATION)
C  EXCEPTIONS FOR LATLON OR GAUSSIAN
      IF(kgds(1).EQ.0.OR.kgds(1).EQ.4) THEN
        igds(11)=kgds(10)
        igds(12)=kgds(9)
C  EXCEPTIONS FOR MERCATOR
      ELSEIF(kgds(1).EQ.1) THEN
        igds(11)=kgds(13)
        igds(12)=kgds(12)
        igds(13)=kgds(9)
        igds(14)=kgds(11)
C  EXCEPTIONS FOR LAMBERT CONFORMAL
      ELSEIF(kgds(1).EQ.3) THEN
        igds(15)=kgds(12)
        igds(16)=kgds(13)
        igds(17)=kgds(14)
        igds(18)=kgds(15)
      ENDIF
C  EXTENSION FOR PL PARAMETERS
      IF(kgds(1).EQ.0.AND.kgds(19).EQ.0.AND.kgds(20).NE.255) THEN
        DO j=1,kgds(3)
          igds(18+j)=kgds(21+j)
        ENDDO
      ENDIF
 
      RETURN
      END