      SUBROUTINE W3FI68 (ID, PDS)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    W3FI68      CONVERT 25 WORD ARRAY TO GRIB PDS
C   PRGMMR: R.E.JONES        ORG: W/NMC42    DATE: 91-05-14
C
C ABSTRACT: CONVERTS AN ARRAY OF 25, OR 27 INTEGER WORDS INTO A
C   GRIB PRODUCT DEFINITION SECTION (PDS) OF 28 BYTES , OR 30 BYTES.
C   IF PDS BYTES > 30, THEY ARE SET TO ZERO.
C
C PROGRAM HISTORY LOG:
C   91-05-08  R.E.JONES
C   92-09-25  R.E.JONES   CHANGE TO 25 WORDS OF INPUT, LEVEL
C                         CAN BE IN TWO WORDS. (10,11)
C   93-01-08  R.E.JONES   CHANGE FOR TIME RANGE INDICATOR IF 10,
C                         STORE TIME P1 IN PDS BYTES 19-20.
C   93-01-26  R.E.JONES   CORRECTION FOR FIXED HEIGHT ABOVE
C                         GROUND LEVEL
C   93-03-29  R.E.JONES   ADD SAVE STATEMENT
C   93-06-24  CAVANOUGH   MODIFIED PROGRAM TO ALLOW FOR GENERATION
C                         OF PDS GREATER THAN 28 BYTES (THE DESIRED
C                         PDS SIZE IS IN ID(1).
C   93-09-30  FARLEY      CHANGE TO ALLOW FOR SUBCENTER ID; PUT
C                         ID(24) INTO PDS(26).
C   93-10-12  R.E.JONES   CHANGES FOR ON388 REV. OCT 9,1993, NEW
C                         LEVELS 125, 200, 201.
C   94-02-23  R.E.JONES   TAKE OUT SBYTES, REPLACE WITH DO LOOP
C   94-04-14  R.E.JONES   CHANGES FOR ON388 REV. MAR 24,1994, NEW
C                         LEVELS 115,116.
C   94-12-04  R.E.JONES   CHANGE TO ADD ID WORDS 26, 27 FOR PDS
C                         BYTES 29 AND 30.
C   95-09-07  R.E.JONES   CHANGE FOR NEW LEVEL 117, 119.
C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
C   98-06-30  EBISUZAKI   LINUX PORT
C 2001-06-05  GILBERT     Changed fortran intrinsic function OR() to
C                         f90 standard intrinsic IOR().
C 2003-02-25  IREDELL     RECOGNIZE LEVEL TYPE 126
C 2005-05-06  D.C.STOKES  RECOGNIZE LEVEL TYPES 235, 237, 238
C
C USAGE:    CALL W3FI68 (ID, PDS)
C   INPUT ARGUMENT LIST:
C     ID       - 25, 27 WORD INTEGER ARRAY
C   OUTPUT ARGUMENT LIST:
C     PDS      - 28 30,  OR GREATER CHARACTER PDS FOR EDITION 1
C
C REMARKS: LAYOUT OF 'ID' ARRAY:
C     ID(1)  = NUMBER OF BYTES IN PRODUCT DEFINITION SECTION (PDS)
C     ID(2)  = PARAMETER TABLE VERSION NUMBER
C     ID(3)  = IDENTIFICATION OF ORIGINATING CENTER
C     ID(4)  = MODEL IDENTIFICATION (ALLOCATED BY ORIGINATING CENTER)
C     ID(5)  = GRID IDENTIFICATION
C     ID(6)  = 0 IF NO GDS SECTION, 1 IF GDS SECTION IS INCLUDED
C     ID(7)  = 0 IF NO BMS SECTION, 1 IF BMS SECTION IS INCLUDED
C     ID(8)  = INDICATOR OF PARAMETER AND UNITS (TABLE 2)
C     ID(9)  = INDICATOR OF TYPE OF LEVEL       (TABLE 3)
C     ID(10) = VALUE 1 OF LEVEL  (0 FOR 1-100,102,103,105,107
C              109,111,113,115,117,119,125,126,160,200,201,
C              235,237,238
C              LEVEL IS IN ID WORD 11)
C     ID(11) = VALUE 2 OF LEVEL
C     ID(12) = YEAR OF CENTURY
C     ID(13) = MONTH OF YEAR
C     ID(14) = DAY OF MONTH
C     ID(15) = HOUR OF DAY
C     ID(16) = MINUTE OF HOUR   (IN MOST CASES SET TO 0)
C     ID(17) = FCST TIME UNIT
C     ID(18) = P1 PERIOD OF TIME
C     ID(19) = P2 PERIOD OF TIME
C     ID(20) = TIME RANGE INDICATOR
C     ID(21) = NUMBER INCLUDED IN AVERAGE
C     ID(22) = NUMBER MISSING FROM AVERAGES
C     ID(23) = CENTURY  (20, CHANGE TO 21 ON JAN. 1, 2001)
C     ID(24) = SUBCENTER IDENTIFICATION
C     ID(25) = SCALING POWER OF 10
C     ID(26) = FLAG BYTE, 8 ON/OFF FLAGS
C              BIT NUMBER  VALUE  ID(26)   DEFINITION
C              1           0      0      FULL FCST FIELD
C                          1      128    FCST ERROR FIELD
C              2           0      0      ORIGINAL FCST FIELD
C                          1      64     BIAS CORRECTED FCST FIELD
C              3           0      0      ORIGINAL RESOLUTION RETAINED
C                          1      32     SMOOTHED FIELD
C              NOTE: ID(26) CAN BE THE SUM OF BITS 1, 2, 3.
C              BITS 4-8 NOT USED, SET TO ZERO
C              IF ID(1) IS 28, YOU DO NOT NEED ID(26) AND ID(27).
C     ID(27) = UNUSED, SET TO 0 SO PDS BYTE 30 IS SET TO ZERO.
C
C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
C
C ATTRIBUTES:
C   LANGUAGE: SiliconGraphics 3.5 FORTRAN 77
C   MACHINE:  SiliconGraphics IRIS-4D/25, 35, INDIGO, Indy
C   LANGUAGE: CRAY CFT77 FORTRAN
C   MACHINE:  CRAY C916/256, J916/2048
C
C$$$
C
      INTEGER        ID(*)
C
      CHARACTER * 1  PDS(*)
C
        PDS(1)  = CHAR(MOD(ID(1)/65536,256))
        PDS(2)  = CHAR(MOD(ID(1)/256,256))
        PDS(3)  = CHAR(MOD(ID(1),256))
        PDS(4)  = CHAR(ID(2))
        PDS(5)  = CHAR(ID(3))
        PDS(6)  = CHAR(ID(4))
        PDS(7)  = CHAR(ID(5))
	i = 0
	if (ID(6).ne.0) i = i + 128
	if (ID(7).ne.0) i = i + 64
	PDS(8) = char(i)

        PDS(9)  = CHAR(ID(8))
        PDS(10) = CHAR(ID(9))
        I9      = ID(9)
C
C       TEST TYPE OF LEVEL TO SEE IF LEVEL IS IN TWO
C       WORDS OR ONE
C
        IF ((I9.GE.1.AND.I9.LE.100).OR.I9.EQ.102.OR.
     &       I9.EQ.103.OR.I9.EQ.105.OR.I9.EQ.107.OR.
     &       I9.EQ.109.OR.I9.EQ.111.OR.I9.EQ.113.OR.
     &       I9.EQ.115.OR.I9.EQ.117.OR.I9.EQ.119.OR.
     &       I9.EQ.125.OR.I9.EQ.126.OR.I9.EQ.160.OR.
     &       I9.EQ.200.OR.I9.EQ.201.OR.I9.EQ.235.OR.
     &       I9.EQ.237.OR.I9.EQ.238) THEN
          LEVEL   = ID(11)
          IF (LEVEL.LT.0) THEN
            LEVEL = - LEVEL
            LEVEL = IOR(LEVEL,32768)
          END IF
          PDS(11) = CHAR(MOD(LEVEL/256,256))
          PDS(12) = CHAR(MOD(LEVEL,256))
        ELSE
          PDS(11) = CHAR(ID(10))
          PDS(12) = CHAR(ID(11))
        END IF
        PDS(13) = CHAR(ID(12))
        PDS(14) = CHAR(ID(13))
        PDS(15) = CHAR(ID(14))
        PDS(16) = CHAR(ID(15))
        PDS(17) = CHAR(ID(16))
        PDS(18) = CHAR(ID(17))
C
C       TEST TIME RANGE INDICATOR (PDS BYTE 21) FOR 10
C       IF SO PUT TIME P1 IN PDS BYTES 19-20.
C
        IF (ID(20).EQ.10) THEN
          PDS(19) = CHAR(MOD(ID(18)/256,256))
          PDS(20) = CHAR(MOD(ID(18),256))
        ELSE
          PDS(19) = CHAR(ID(18))
          PDS(20) = CHAR(ID(19))
        END IF
        PDS(21) = CHAR(ID(20))
        PDS(22) = CHAR(MOD(ID(21)/256,256))
        PDS(23) = CHAR(MOD(ID(21),256))
        PDS(24) = CHAR(ID(22))
        PDS(25) = CHAR(ID(23))
        PDS(26) = CHAR(ID(24))
        ISCALE  = ID(25)
        IF (ISCALE.LT.0) THEN
          ISCALE = -ISCALE
          ISCALE =  IOR(ISCALE,32768)
        END IF
        PDS(27) = CHAR(MOD(ISCALE/256,256))
        PDS(28) = CHAR(MOD(ISCALE    ,256))
        IF (ID(1).GT.28) THEN
          PDS(29) = CHAR(ID(26))
          PDS(30) = CHAR(ID(27))
        END IF
C
C       SET PDS 31-?? TO ZERO
C
        IF (ID(1).GT.30) THEN
          K = ID(1)
          DO I = 31,K
            PDS(I) = CHAR(0)
          END DO
        END IF
C
      RETURN
      END
