ungrib/src/ngl/w3/r63w72.f

   1       SUBROUTINE R63W72(KPDS,KGDS,IPDS,IGDS)
   2 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 C
   4 C SUBPROGRAM:    R63W72      CONVERT W3FI63 PARMS TO W3FI72 PARMS
   5 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 92-10-31
   6 C
   7 C ABSTRACT: DETERMINES THE INTEGER PDS AND GDS PARAMETERS
   8 C           FOR THE GRIB1 PACKING ROUTINE W3FI72 GIVEN THE PARAMETERS
   9 C           RETURNED FROM THE GRIB1 UNPACKING ROUTINE W3FI63.
  10 C
  11 C PROGRAM HISTORY LOG:
  12 C   91-10-31  MARK IREDELL
  13 C   96-05-03  MARK IREDELL  CORRECTED SOME LEVEL TYPES AND
  14 C                           SOME DATA REPRESENTATION TYPES
  15 C   97-02-14  MARK IREDELL  ONLY ALTERED IPDS(26:27) FOR EXTENDED PDS
  16 C   98-06-01  CHRIS CARUSO  Y2K FIX FOR YEAR OF CENTURY
  17 C 2005-05-06  DIANE STOKES  RECOGNIZE LEVEL 236
  18 C
  19 C USAGE:    CALL R63W72(KPDS,KGDS,IPDS,IGDS)
  20 C
  21 C   INPUT ARGUMENT LIST:
  22 C     KPDS     - INTEGER (200) PDS PARAMETERS FROM W3FI63
  23 C     KGDS     - INTEGER (200) GDS PARAMETERS FROM W3FI63
  24 C
  25 C   OUTPUT ARGUMENT LIST:
  26 C     IPDS     - INTEGER (200) PDS PARAMETERS FOR W3FI72
  27 C     IGDS     - INTEGER (200) GDS PARAMETERS FOR W3FI72
  28 C
  29 C REMARKS: KGDS AND IGDS EXTEND BEYOND THEIR DIMENSIONS HERE
  30 C          IF PL PARAMETERS ARE PRESENT.
  31 C
  32 C ATTRIBUTES:
  33 C   LANGUAGE: CRAY FORTRAN
  34 C
  35 C$$$
  36       DIMENSION KPDS(200),KGDS(200),IPDS(200),IGDS(200)
  37 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  38 C  DETERMINE PRODUCT DEFINITION SECTION (PDS) PARAMETERS
  39       IF(KPDS(23).NE.2) THEN
  40         IPDS(1)=28                      ! LENGTH OF PDS
  41       ELSE
  42         IPDS(1)=45                      ! LENGTH OF PDS
  43       ENDIF
  44       IPDS(2)=KPDS(19)                  ! PARAMETER TABLE VERSION
  45       IPDS(3)=KPDS(1)                   ! ORIGINATING CENTER
  46       IPDS(4)=KPDS(2)                   ! GENERATING MODEL
  47       IPDS(5)=KPDS(3)                   ! GRID DEFINITION
  48       IPDS(6)=MOD(KPDS(4)/128,2)        ! GDS FLAG
  49       IPDS(7)=MOD(KPDS(4)/64,2)         ! BMS FLAG
  50       IPDS(8)=KPDS(5)                   ! PARAMETER INDICATOR
  51       IPDS(9)=KPDS(6)                   ! LEVEL TYPE
  52       IF(KPDS(6).EQ.101.OR.KPDS(6).EQ.104.OR.KPDS(6).EQ.106.OR.
  53      &   KPDS(6).EQ.108.OR.KPDS(6).EQ.110.OR.KPDS(6).EQ.112.OR.
  54      &   KPDS(6).EQ.114.OR.KPDS(6).EQ.116.OR.KPDS(6).EQ.121.OR.
  55      &   KPDS(6).EQ.128.OR.KPDS(6).EQ.141.OR.KPDS(6).EQ.236)  THEN
  56         IPDS(10)=MOD(KPDS(7)/256,256)   ! LEVEL VALUE 1
  57         IPDS(11)=MOD(KPDS(7),256)       ! LEVEL VALUE 2
  58       ELSE
  59         IPDS(10)=0                      ! LEVEL VALUE 1
  60         IPDS(11)=KPDS(7)                ! LEVEL VALUE 2
  61       ENDIF
  62       IPDS(12)=KPDS(8)                  ! YEAR OF CENTURY
  63       IPDS(13)=KPDS(9)                  ! MONTH
  64       IPDS(14)=KPDS(10)                 ! DAY
  65       IPDS(15)=KPDS(11)                 ! HOUR
  66       IPDS(16)=KPDS(12)                 ! MINUTE
  67       IPDS(17)=KPDS(13)                 ! FORECAST TIME UNIT
  68       IPDS(18)=KPDS(14)                 ! TIME RANGE 1
  69       IPDS(19)=KPDS(15)                 ! TIME RANGE 2
  70       IPDS(20)=KPDS(16)                 ! TIME RANGE INDICATOR
  71       IPDS(21)=KPDS(17)                 ! NUMBER IN AVERAGE
  72       IPDS(22)=KPDS(20)                 ! NUMBER MISSING IN AVERAGE
  73       IPDS(23)=KPDS(21)                 ! CENTURY
  74       IPDS(24)=KPDS(23)                 ! SUBCENTER
  75       IPDS(25)=KPDS(22)                 ! DECIMAL SCALING
  76       IF(IPDS(1).GT.28) THEN
  77         IPDS(26)=0                      ! PDS BYTE 29
  78         IPDS(27)=0                      ! PDS BYTE 30
  79       ENDIF
  80 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  81 C  DETERMINE GRID DEFINITION SECTION (GDS) PARAMETERS
  82       IGDS(1)=KGDS(19)                  ! NUMBER OF VERTICAL COORDINATES
  83       IGDS(2)=KGDS(20)                  ! VERTICAL COORDINATES
  84       IGDS(3)=KGDS(1)                   ! DATA REPRESENTATION
  85       IGDS(4)=KGDS(2)                   ! (UNIQUE TO REPRESENTATION)
  86       IGDS(5)=KGDS(3)                   ! (UNIQUE TO REPRESENTATION)
  87       IGDS(6)=KGDS(4)                   ! (UNIQUE TO REPRESENTATION)
  88       IGDS(7)=KGDS(5)                   ! (UNIQUE TO REPRESENTATION)
  89       IGDS(8)=KGDS(6)                   ! (UNIQUE TO REPRESENTATION)
  90       IGDS(9)=KGDS(7)                   ! (UNIQUE TO REPRESENTATION)
  91       IGDS(10)=KGDS(8)                  ! (UNIQUE TO REPRESENTATION)
  92       IGDS(11)=KGDS(9)                  ! (UNIQUE TO REPRESENTATION)
  93       IGDS(12)=KGDS(10)                 ! (UNIQUE TO REPRESENTATION)
  94       IGDS(13)=KGDS(11)                 ! (UNIQUE TO REPRESENTATION)
  95       IGDS(14)=KGDS(12)                 ! (UNIQUE TO REPRESENTATION)
  96       IGDS(15)=KGDS(13)                 ! (UNIQUE TO REPRESENTATION)
  97       IGDS(16)=KGDS(14)                 ! (UNIQUE TO REPRESENTATION)
  98       IGDS(17)=KGDS(15)                 ! (UNIQUE TO REPRESENTATION)
  99       IGDS(18)=KGDS(16)                 ! (UNIQUE TO REPRESENTATION)
 100 C  EXCEPTIONS FOR LATLON OR GAUSSIAN
 101       IF(KGDS(1).EQ.0.OR.KGDS(1).EQ.4) THEN
 102         IGDS(11)=KGDS(10)
 103         IGDS(12)=KGDS(9)
 104 C  EXCEPTIONS FOR MERCATOR
 105       ELSEIF(KGDS(1).EQ.1) THEN
 106         IGDS(11)=KGDS(13)
 107         IGDS(12)=KGDS(12)
 108         IGDS(13)=KGDS(9)
 109         IGDS(14)=KGDS(11)
 110 C  EXCEPTIONS FOR LAMBERT CONFORMAL
 111       ELSEIF(KGDS(1).EQ.3) THEN
 112         IGDS(15)=KGDS(12)
 113         IGDS(16)=KGDS(13)
 114         IGDS(17)=KGDS(14)
 115         IGDS(18)=KGDS(15)
 116       ENDIF
 117 C  EXTENSION FOR PL PARAMETERS
 118       IF(KGDS(1).EQ.0.AND.KGDS(19).EQ.0.AND.KGDS(20).NE.255) THEN
 119         DO J=1,KGDS(3)
 120           IGDS(18+J)=KGDS(21+J)
 121         ENDDO
 122       ENDIF
 123 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 124       RETURN
 125       END