SUBROUTINE W3FP12(ID8, IFLAG, IDPDS, ICENT, ISCALE, IER) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: W3FP12 CREATES THE PRODUCT DEFINITION SECTION C PRGMMR: MCCLEES ORG: NMC421 DATE:92-01-14 C C ABSTRACT: FORMATS THE PRODUCT DEFINITION SECTION ACCORDING TO THE C SPECIFICATIONS SET BY WMO. USING O.N. 84 ID'S (1ST 8 WORDS) C AS THE INPUT DATA. NEW SUBROUTINE CORRESPONDS TO THE REVISION C #1 OF THE WMO GRIB STANDARDS MADE MARCH 15, 1991. C C PROGRAM HISTORY LOG: C 91-07-30 MCCLEES,A.J. NEW SUBROUTINE WHICH FORMATS THE PDS C SECTION FROM THE O.N. 84 ID'S FROM THE GRIB C EDITION 1 DATED MARCH 15, 1991. C C 92-01-06 MCCLEES,A.J. DELETE PARAMATER 202 (ACCUMULATED EVAP) C AND MAKE PARAMETER 57 (EVAPORATION) THE C EQUIVALENT OF O.N.84 117. C 92-11-02 R.E.JONES CORRECTION AT SAME LEVEL AS W3FP12 IN C V77W3LIB ON HDS 92-09-30 C 93-03-29 R.E.JONES ADD SAVE STATEMENT C 93-04-16 R.E.JONES ADD 176, 177 LAT, LON TO TABLES C 93-08-03 R.E.JONES ADD 156 (CIN), 204 (DSWRF), 205 (DLWRF) C 211 (USWRF), 212 (ULWRF) TO TABLES C 95-02-07 R.E.JONES CHANGE PDS BYTE 4, VERSION NUMBER TO 2. C 95-07-14 R.E.JONES CORRECTION FOR SFC LFT X C 98-03-10 B. VUONG REMOVE THE CDIR$ INTEGER=64 DIRECTIVE C 98-12-21 Gilbert Replaced Function ICHAR with mova2i. C 99-02-15 B. FACEY REPLACE W3FS04 WITH W3MOVDAT. C 1999-03-15 Gilbert Specified 8-byte integer array explicitly for ID8 C 99-03-22 B. FACEY REMOVE THE DATE RECALCULATION FOR MEAN C CHARTS. THIS INCLUDES THE PREVIOUS C CHANGE TO W3MOVDAT. C C USAGE: CALL W3FP12 (ID8, IFLAG, IDPDS, ICENT, ISCALE, IER) C INPUT ARGUMENT LIST: C ID8 - FIRST 8 ID WORKDS (O.N.84) INTEGER*4 C ICENT - CENTURY, 2 DIGITS, FOR 1991 IT IS 20. C IFLAG - INDICATION OF INCLUSION OR OMISSION OF GRID DEFINITION C AND/OR BIT MAP CODE CHARACTER*1 C ISCALE - 10 SCALER INTEGER*4 C C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) C IDPDS - GRIB PRODUCT DEFINITION SECTION CHARACTER*1 (28) C IER = 0 COMPLETED SMOOTHLY C = 1 INDICATOR PARAMETER N.A. TO GRIB C = 2 LEVEL INDICATOR N.A. TO GRIB C = 3 TIME RANGE N.A. TO GRIB NOTATION C = 4 LAYERS OR LEVELS N.A. TO GRIB C OUTPUT FILES: C FT06F001 - SELF-EXPLANATORY ERROR MESSAGES C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C C$$$ C INTEGER E1 INTEGER E2 INTEGER F1 INTEGER F2 DATA F1/0/, F2/0/ INTEGER HH (163) INTEGER(8) ID8 ( 4) INTEGER(8) IDWK ( 4) INTEGER(8) MSK1,MSK2,MSK3,MSK4,MSK5,MSK6,MSK7 INTEGER ISIGN INTEGER ISCALE INTEGER ICENT INTEGER LL (163) INTEGER L INTEGER M INTEGER N INTEGER Q INTEGER S1 INTEGER T DATA T/0/ C CHARACTER*1 IDPDS (28) CHARACTER*1 IFLAG CHARACTER*1 IHOLD ( 8) CHARACTER*1 IPDS1 ( 8) CHARACTER*1 KDATE ( 8) CHARACTER*1 LIDWK (32) C EQUIVALENCE (IDWK(1),LIDWK(1)) EQUIVALENCE (L,IPDS1(1)) EQUIVALENCE (NBYTES,IHOLD(1)) EQUIVALENCE (JDATE,KDATE(1)) REAL RINC(5) INTEGER NDATE(8), MDATE(8) C DATA LL / 8, 8, 9, 255, 255, 255, 1, 6, 255, 255, & 16, 24, 19, 23, 20, 21, 17, 18, 255, 180, & 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, & 55, 50, 48, 56, 49, 57, 80, 81, 71, 255, & 40, 42, 72, 74, 73, 255, 255, 255, 255, 255, & 304, 305, 95, 88, 101, 89, 104, 255, 117, 255, & 97, 98, 90, 105, 94, 255, 255, 93, 188, 255, & 255, 255, 255, 211, 255, 255, 255, 255, 255, 255, & 255, 384, 161, 255, 255, 169, 22, 255, 255, 255, & 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, & 255, 400, 389, 385, 388, 391, 386, 390, 402, 401, & 404, 403, 204, 255, 255, 255, 255, 255, 255, 255, & 255, 255, 195, 194, 255, 255, 255, 255, 255, 255, & 255, 255, 112, 116, 114, 255, 103, 52, 255, 255, & 255, 255, 119, 157, 158, 159, 255, 176, 177, 392, & 192, 190, 199, 216, 189, 193, 191, 210, 198, 255, & 255, 1, 255/ DATA HH / 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, & 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, & 31, 32, 33, 33, 34, 34, 35, 36, 37, 38, & 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, & 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, & 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, & 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, & 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, & 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, & 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, & 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, & 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, & 129, 130, 131, 132, 133, 134, 135, 136, 137, 150, & 151, 152, 156, 157, 158, 159, 175, 176, 177, 201, & 204, 205, 207, 208, 209, 211, 212, 213, 216, 218, & 220, 222, 255/ C DATA MSK1 /Z'00000FFF'/, C & MSK2 /Z'0FFFFF00'/, C & MSK3 /Z'0000007F'/, C & MSK4 /Z'00000080'/, C & MSK5 /Z'F0000000'/, C & MSK6 /Z'00000200'/, C & MSK7 /Z'000000FF'/ C CHANGE HEX TO DECIMAL TO MAKE SUBROUTINE MORE PORTABLE DATA MSK1 /4095/, & MSK2 /268435200/, & MSK3 /127/, & MSK4 /128/, & MSK5 /Z'00000000F0000000'/ & MSK6 /512/, & MSK7 /255/ C C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C C$ 1.0 INITIALIZATION - NO. OF ENTRIES IN INDCATOR PARM. C$ - NO. OF ENTRIES IN TYPE LEVEL C IQ = 163 C C$ 1.1 COPY O.N. 84 ID'S INTO WORK SPACE C DO 100 N = 1,4 IDWK(N) = ID8(N) 100 CONTINUE C --------------------------------------------------------------------- C 2.0 NO. OF OCTETS IN THE PDS IN THE FIRST 3 C$ 2.1 SET CNTR ID, DATA TYPE, GRID DEF AND FLAG C NBYTES = 28 IDPDS(1) = IHOLD(6) IDPDS(2) = IHOLD(7) IDPDS(3) = IHOLD(8) IDPDS(4) = CHAR(2) IDPDS(5) = CHAR(7) IDPDS(6) = LIDWK(30) JSCALE = ISCALE IF (JSCALE.LT.0) THEN JSCALE = -JSCALE IDPDS(27) = CHAR(128) IDPDS(28) = CHAR(JSCALE) ELSE IDPDS(27) = CHAR(0) IDPDS(28) = CHAR(JSCALE) END IF C IF (LIDWK(30) .EQ. CHAR (69)) THEN IF (LIDWK(29) .EQ. CHAR(3)) THEN IDPDS(6) = CHAR(68) ELSE IF (LIDWK(29) .EQ. CHAR(4)) THEN IDPDS(6) = CHAR(69) ENDIF ENDIF IF (LIDWK(30) .EQ. CHAR (78)) THEN IF (LIDWK(29) .EQ. CHAR(3)) THEN IDPDS(6) = CHAR(77) ELSE IF (LIDWK(29) .EQ. CHAR(4)) THEN IDPDS(6) = CHAR(78) ENDIF ENDIF IDPDS(7) = LIDWK(20) IF (LIDWK(20) .EQ. CHAR (26)) IDPDS(7) = CHAR(6) IDPDS(8) = IFLAG IDPDS(24) = CHAR(0) IDPDS(26) = CHAR(0) C--------------------------------------------------------------------- C C$ 3.0 FORM INDICATOR PARAMETER C Q = ISHFT(IDWK(1),-52_8) DO 300 I = 1,IQ II = I IF (Q .EQ. LL(I)) GO TO 310 300 CONTINUE C IER = 1 PRINT 320, IER, Q, ID8 320 FORMAT (' W3FP12 (320) - IER = ',I2,', Q = ',I3,/, & ' OFFICE NOTE 84 PARAMETER N.A. IN GRIB', & /,1X,4(Z16,' ')) RETURN C 310 I = II S1 = IAND(ISHFT(IDWK(1),-40_8),MSK1) C1 = ISHFT(IAND(IDWK(1),MSK2),-8_8) ISIG1 = IAND(IDWK(1),MSK4) E1 = IAND(IDWK(1),MSK3) IF (ISIG1 .NE. 0) E1 = -E1 M = ISHFT(IAND(ISHFT(IDWK(2),-32_8),MSK5),-28_8) N = ISHFT(IAND(IDWK(2),MSK5),-28_8) KS = ISHFT(IAND(ISHFT(IDWK(3),-32_8),MSK6),-8_8) IF (M.NE.0) THEN C2 = ISHFT(IAND(IDWK(2),MSK2),-8_8) ISIG2 = IAND(IDWK(2),MSK4) E2 = IAND(IDWK(2),MSK3) IF (ISIG2 .NE. 0) E2 = -E2 ENDIF IDPDS(9) = CHAR(HH(I)) C C N IS A SPECIAL TEST FOR WAVE HGTS, M AND KS ARE SPECIAL FOR C ACCUMULATED PRECIP C IF (N .EQ. 5 .AND. Q .EQ. 1) THEN IDPDS(9) = CHAR (222) ENDIF IF (KS .EQ. 2) THEN IF (M .EQ. 0 .AND. Q .EQ. 8) THEN IDPDS(9) = CHAR (211) END IF C IF (M .EQ. 0 .AND. Q .EQ. 1) THEN IDPDS(9) = CHAR (210) ENDIF C IF (M .EQ. 1 .AND. Q .EQ. 1) THEN IER = 1 PRINT 330, IER, ID8 330 FORMAT (' W3FP12 (330) - IER =',I2,/, & ' OFFICE NOTE 84 PARAMETER N.A. IN GRIB', & /,1X,4(Z16,' ')) RETURN ENDIF ENDIF C C$ 4.0 DETERMINE IF LAYERS OR LEVEL AND FORM TYPE C C ......... M = THE M MARKER FROM O.N.84 CHECK ABOVE C ......... S1 = S1 TYPE OF SURFACE C IF (M .EQ. 0) THEN IF (S1.EQ.0.AND.(Q.EQ.176.OR.Q.EQ.177)) THEN IDPDS(10) = CHAR(0) IDPDS(11) = CHAR(0) IDPDS(12) = CHAR(0) C ELSE IF (S1 .EQ. 8) THEN IDPDS(10) = CHAR (100) L = C1 * (10. ** E1) + .5 IDPDS(11) = IPDS1(7) IDPDS(12) = IPDS1(8) C ELSE IF (S1 .EQ. 1) THEN IDPDS(10) = CHAR (103) L = C1 * (10. ** E1) + .5 IDPDS(11) = IPDS1(7) IDPDS(12) = IPDS1(8) C ELSE IF (S1 .EQ. 6) THEN IDPDS(10) = CHAR (105) L = C1 * (10. ** E1) + .5 IDPDS(11) = IPDS1(7) IDPDS(12) = IPDS1(8) C ELSE IF (S1 .EQ. 7) THEN IDPDS(10) = CHAR (111) C CONVERT FROM METERS TO CENTIMETERS IF (ISIG1 .NE. 0) E1 = E1 + 2 L = C1 * (10. ** E1) + .5 IDPDS(11) = IPDS1(7) IDPDS(12) = IPDS1(8) C ELSE IF (S1.EQ.148 .OR. S1 .EQ. 144 .OR. S1 .EQ. 145) THEN IDPDS(10) = CHAR (107) L = (C1 * (10. ** E1) * 10**4) + .5 IDPDS(11) = IPDS1(7) IDPDS(12) = IPDS1(8) C ELSE IF (S1 .EQ. 16) THEN L = C1 * (10. ** E1) + .5 IF (L .EQ. 273) THEN IDPDS(10) = CHAR (4) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) ELSE IER = 2 PRINT 410, IER, S1, ID8 RETURN ENDIF C ELSE IF (S1 .EQ. 19) THEN L = C1 * (10. ** E1) + .5 IDPDS(10) = CHAR (113) IDPDS(11) = IPDS1(7) IDPDS(12) = IPDS1(8) C C SET LEVEL AND PARAMETER FOR MSL PRESSURE C ELSE IF (S1 .EQ. 128) THEN IF (Q.EQ.8) THEN IDPDS(9) = CHAR(2) END IF IDPDS(10) = CHAR (102) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IF (S1 .EQ. 129) THEN IDPDS(10) = CHAR (1) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IF (S1 .EQ. 130) THEN IDPDS(10) = CHAR (7) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IF (S1 .EQ. 131) THEN IDPDS(10) = CHAR (6) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IF (S1 .EQ. 133) THEN IDPDS(10) = CHAR (1) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IF (S1 .EQ. 136) THEN IF (Q.EQ.8) THEN IF (T.EQ.2.AND.F1.EQ.0.AND.F2.EQ.3) THEN IDPDS(9) = CHAR (137) ELSE IDPDS(9) = CHAR (128) END IF END IF IDPDS(10) = CHAR (102) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IF (S1 .EQ. 137) THEN IF (Q.EQ.8) THEN IDPDS(9) = CHAR (129) END IF IDPDS(10) = CHAR (102) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IF (S1 .EQ. 138) THEN IF (Q.EQ.8) THEN IDPDS(9) = CHAR (130) END IF IDPDS(10) = CHAR (102) IDPDS(11) = CHAR (0) IDPDS(12) = CHAR (0) C ELSE IER = 2 PRINT 410, IER, S1, ID8 410 FORMAT (' W3FP12 (410) - IER = ',I2,', S1 = ',I5,/, & ' SURFACE TYPE N.A. IN GRIB',/,' ID8 = ', & 4(Z16,' ')) RETURN ENDIF C ELSE IF (M .EQ. 1) THEN IF ((S1 .EQ. 8) .AND. (Q .EQ. 1)) THEN IDPDS(9) = CHAR(101) IDPDS(10) = CHAR(101) JJJ = ((C1 * 10. ** E1) * .1) + .5 IDPDS(11) = CHAR(JJJ) KKK = ((C2 * 10. ** E2) * .1) + .5 IDPDS(12) = CHAR(KKK) END IF C ELSE IF (M .EQ. 2) THEN IF (S1 .EQ. 8) THEN IDPDS(10) = CHAR(101) JJJ = ((C1 * 10. ** E1) * .1) + .5 IDPDS(11) = CHAR(JJJ) KKK = ((C2 * 10. ** E2) * .1) + .5 IDPDS(12) = CHAR(KKK) IF (IDPDS(9) .EQ. CHAR(131)) IDPDS(12) = CHAR(100) C ELSE IF (S1 .EQ. 1) THEN IDPDS(10) = CHAR(104) JJJ = ((C1 * 10. ** E1) * .1) + .5 IDPDS(11) = CHAR(JJJ) KKK = ((C2 * 10. ** E2) * .1) + .5 IDPDS(12) = CHAR(KKK) C ELSE IF (S1 .EQ. 6) THEN IDPDS(10) = CHAR(106) JJJ = ((C1 * 10. ** E1) * .1) + .5 IDPDS(11) = CHAR(JJJ) KKK = ((C2 * 10. ** E2) * .1) + .5 IDPDS(12) = CHAR(KKK) C ELSE IF (S1.EQ.148 .OR. S1 .EQ. 144 .OR. S1 .EQ. 145) THEN IDPDS(10) = CHAR(108) JJJ = ((C1 * 10. ** E1) * 10**2) + .5 IDPDS(11) = CHAR(JJJ) KKK = ((C2 * 10. ** E2) * 10**2) + .5 IDPDS(12) = CHAR(KKK) C ELSE IER = 2 PRINT 420, IER, S1, ID8 420 FORMAT (' W3FP12 (420) - IER = ',I2,', S1 = ',I5,/, & ' SURFACE LAYERS N.A. IN GRIB', & /,' ID8= ',4(Z16,' ')) RETURN ENDIF ELSE IF (M .GT. 2) THEN IER = 4 PRINT 500, IER, M, ID8 500 FORMAT ('W3FP12 (500) - IER = ',I2,', M = ',/, & ' THE M FROM O.N. 84 N.A. IN GRIB', & /,' ID8 = ',4(Z16,' ')) RETURN ENDIF C C$ 6.0 DATE - YR.,MO,DA,& INITIAL HR AND CENTURY C IDPDS(13) = LIDWK(25) IDPDS(14) = LIDWK(26) IDPDS(15) = LIDWK(27) IDPDS(16) = LIDWK(28) IDPDS(17) = CHAR(0) IDPDS(25) = CHAR(ICENT) C--------------------------------------------------------------------- C C$ OCTET (17) N.A. FROM O.N. 84 DATA C C$ 7.0 INDICATOR OF TIME UNIT, TIME RANGE 1 AND 2, AND TIME C RANGE FLAG C T = ISHFT((IAND(IDWK(1),MSK5)),-28_8) F1 = IAND(ISHFT(IDWK(1),-32_8),MSK7) F2 = IAND(ISHFT(IDWK(2),-32_8),MSK7) IF (T .EQ. 0) THEN IDPDS(18) = CHAR (1) IDPDS(19) = CHAR (F1) IDPDS(20) = CHAR (0) IDPDS(21) = CHAR (0) IDPDS(22) = CHAR (0) IDPDS(23) = CHAR (0) C ELSE IF (T .EQ. 1) THEN PRINT 710, T, ID8 IER = 3 RETURN C ELSE IF (T .EQ. 2) THEN IF (mova2i(IDPDS(9)).NE.137) THEN PRINT 710, T, ID8 IER = 3 RETURN END IF C ELSE IF (T .EQ. 3) THEN IF (Q .EQ. 89 .OR. Q .EQ. 90 .OR. Q .EQ. 94 & .OR. Q .EQ. 105) THEN C IDPDS(18) = CHAR (1) C CORRECTION FOR 00 HR FCST ITEMP = F1 - F2 IF (ITEMP.LT.0) ITEMP = 0 C IDPDS(19) = CHAR (F1 - F2) IDPDS(19) = CHAR (ITEMP) IDPDS(20) = CHAR (F1) IDPDS(21) = CHAR (4) IDPDS(22) = CHAR (0) IDPDS(23) = CHAR (0) C ELSE IDPDS(18) = CHAR (1) C CORRECTION FOR 00 HR FCST ITEMP = F1 - F2 IF (ITEMP.LT.0) ITEMP = 0 C IDPDS(19) = CHAR (F1 - F2) IDPDS(19) = CHAR (ITEMP) IDPDS(20) = CHAR (F1) IDPDS(21) = CHAR (5) IDPDS(22) = CHAR (0) IDPDS(23) = CHAR (0) END IF C ELSE IF (T .EQ. 4) THEN C IF (F1 .EQ. 0 .AND. F2 .NE. 0) THEN IDPDS(18) = CHAR (4) IDPDS(19) = CHAR (0) IDPDS(20) = CHAR (1) IDPDS(21) = CHAR (124) L = F2 IDPDS(22) = IPDS1(7) IDPDS(23) = IPDS1(8) C ELSE IF (F1 .NE. 0 .AND. F2 .EQ. 0) THEN IDPDS(18) = CHAR (2) IDPDS(19) = CHAR (0) IDPDS(20) = CHAR (1) IDPDS(21) = CHAR (124) L = F1 IDPDS(22) = IPDS1(7) IDPDS(23) = IPDS1(8) C ENDIF C ELSE IF (T .EQ. 5) THEN IDPDS(18) = CHAR (1) C CORRECTION FOR 00 HR FCST ITEMP = F1 - F2 IF (ITEMP.LT.0) ITEMP = 0 C IDPDS(19) = CHAR (F1 - F2) IDPDS(19) = CHAR (ITEMP) IDPDS(20) = CHAR (F1) IDPDS(21) = CHAR (2) IDPDS(22) = CHAR (0) IDPDS(23) = CHAR (0) C ELSE IF (T .EQ. 6) THEN JSIGN = IAND(ISHFT(IDWK(1),-32_8),MSK4) JSIGO = IAND(ISHFT(IDWK(2),-32_8),MSK4) F1 = IAND(ISHFT(IDWK(1),-32_8),MSK3) F2 = IAND(ISHFT(IDWK(2),-32_8),MSK3) IF (JSIGN .NE. 0) F1 = -F1 IF (JSIGO .NE. 0) F2 = -F2 IDPDS(18) = CHAR (1) C****CALCULATE NEW DATE BASED ON THE BEGINNING OF THE DATA IN MEAN C INCR = (F1) C IF (INCR.LT.0) THEN C RINC=0 C RINC(2)=INCR C PRINT *, 'INCR=',INCR C CALL W3FS04 (IDWK(4),JDATE,INCR,IERR) C IYR=ICHAR(LIDWK(25)) C PRINT *, 'IYR = ', IYR C IF(IYR.LT.20)THEN C MDATE(1)=2000+IYR C ELSE C MDATE(1)=1900+IYR C ENDIF C MDATE(2) = ICHAR(LIDWK(26)) C MDATE(3) = ICHAR(LIDWK(27)) C MDATE(4) = ICHAR(LIDWK(28)) C PRINT *, 'CHANGE DATE BY - ', RINC(2) C CALL W3MOVDAT(RINC,MDATE,NDATE) C PRINT *,'NEW DATE =',NDATE(1),NDATE(2),NDATE(3),NDATE(5) C IYEAR = MOD(NDATE(1),100) C LIDWK(25) = CHAR(IYEAR) C LIDWK(26) = CHAR(NDATE(2)) C LIDWK(27) = CHAR(NDATE(3)) C LIDWK(28) = CHAR(NDATE(4)) C END IF IDPDS(13) = LIDWK(25) IDPDS(14) = LIDWK(26) IDPDS(15) = LIDWK(27) IDPDS(16) = LIDWK(28) IF (F1.LT.0) THEN IDPDS(19) = CHAR (0) IDPDS(21) = CHAR (123) ELSE NF1 = F1 * 12 IDPDS(19) = CHAR (NF1) IDPDS(21) = CHAR (113) END IF IDPDS(20) = CHAR (24) C*****THE NUMBER OF CASES AVERAGED IS ASSUMING ONE TIME A DAY C L = (F2/2) + 1 C***THE ABOVE CALCULATION WOULD BE CORR. IF ID8(3) WERE CORR. L = (F2+1) / 2 IDPDS(22) = IPDS1(7) IDPDS(23) = IPDS1(8) C ELSE IF (T .EQ. 7) THEN PRINT 710, T, ID8 IER = 3 RETURN C ELSE IF (T .EQ. 10) THEN PRINT 710, T, ID8 IER = 3 RETURN C 710 FORMAT (' W3FP12 (710) - NOT APPLICABLE (YET) TO GRIB. ', & ', T = ',I2,/, & ' O.N. 84 IDS ARE ',/, & 1X,4(Z16,' ')) C ENDIF IER = 0 RETURN END