SUBROUTINE RGRIB1 (IUNIT,IBUFF,IXB,IWDS,IST) C C /DSS/P/ACC/RUGRIB1 C READS NCEP GRIB EDITION 1 FORMAT. C C *** IT HAS NOT BEEN TESTED ON ALL POSSIBLE RGRIB1 SIMPLY PACKED GRIDS C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C READ STATEMENT MUST BE APPROPRIATE TO TAPE BLOCKING. C NCEP GRIB GLOBALS IN THE DSS ARCHIVE ON THE MSS ARE COS-BLOCKED AND C ARE READ HERE WITH RDTAPE (ON THE NCAR SYSTEM). C C IUNIT INPUT UNIT. C IBUFF THE BUFFER FOR THE READ C IXB LENGTH OF IBUFF C IST READ STATUS WHERE 0 = OK, 1 = EOF, AND 2 = ERROR. C C ALL ID PARAMETERS IN GRIB1 ARE RETURNED AND THEIR MEANINGS ARE EXPLAINED C IN NCEP GRIB1. THEIR VALUES MUST NOT BE MODIFIED BY THE CALLING PROGRAM. C IIDIM AND IJDIM ARE I AND J DIMENSIONS OF GRID WHICH HAS BEEN READ. C DIMENSION IBUFF(1) C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C COMMON / GRIBGDS / LENGDS, IGNV, IPVPL, IGREP C C IBITMAP IS BIG ENOUGH TO HANDLE A GRID TWICE AS BIG AS THE BIGGEST C DOCUMENTED GRID (AS OF 1997JUN27 THAT'S 720X361=259920). IF GRIB C IS STILL AROUND AS MODELS GET BIGGER AND FINER RESOLUTION, THIS C MAY NEED TO BE INCREASED. THE POTENTIAL SIZE OF LENBMS=16777216 C WHICH WOULD BE 4 MINUTES ON A GLOBAL LONG/LAT GRID. C COMMON / GRIBBMS / LENBMS, IUNUSE3, IBMAP, XMSG, IBITMAP(500000) C COMMON / GRIBBDS / LENBDS, IFLAG1, IFLAG2, IFLAG3, IFLAG4, 2 ISTART, IUNUSE4, IBINF, REFMIN, IPTBITS, IFLAGE C DIMENSION IDIM(256), JDIM(256) C C GRID DIMENSIONS (POINTER IS = IGRID+1) NEGATIVE VALUES INDICATE C THAT A POLE POINT, NOT AN ENTIRE ROW, IS ALSO INCLUDED, WHICH C REQUIRES SPECIAL HANDLING... C 1 2 3 4 5 6 7 8 9 10 C DATA (IDIM(IDF),IDF=1,80) / . 47, 73, 144, 360, 720, 53, 53, 0, 0, 0, 1 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2 0, -37, -37, -37, -37, -72, -72, 65, 65, 145, 3 145, 0, 0, 181, 181, 0, 0,3447,3447,3447, 4 3447,3447,3447,3447,3447, 0, 0, 0, 0, 0, 5 928, 0, 0, 0, 0, 87, 87, 0, 0, 0, 6 0, -91, -91, -91, -91, 0, 0, 0, 0, 0, 7 0, 0, 0, 0, 0, 111, 111, 111, 0, 0/ DATA (IDIM(IDF),IDF=81,160) / 8 0, 0, 0, 0, 0, 360, 360, 81, 0, 0, 9 92, 183, 127, 253, 0, 0, 0, 0, 0, 0, . 83, 113, 0, 65, 147, 83, 165, 120, 0, 0, 1 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ DATA (IDIM(IDF),IDF=161,256) / 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 65, 65, 45, 93, 45, 51, 49, 29, 101, 1 25, 93, 185, 129, 97, 0, 0, 0, 0, 0, 5 36*0/ C C 1 2 3 4 5 6 7 8 9 10 C DATA (JDIM(IDF),IDF=1,80) / . 51, 23, 73, 181, 361, 57, 45, 0, 0, 0, 1 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2 0, 36, 36, 36, 36, 18, 18, 65, 65, 37, 3 37, 0, 0, 46, 46, 0, 0, 1, 1, 1, 4 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 5 1, 0, 0, 0, 0, 71, 71, 0, 0, 0, 6 0, 45, 45, 45, 45, 0, 0, 0, 0, 0, 7 0, 0, 0, 0, 0, 111, 111, 111, 0, 0/ DATA (JDIM(IDF),IDF=81,160) / 8 0, 0, 0, 0, 0, 90, 90, 62, 0, 0, 9 141, 141, 191, 191, 0, 0, 0, 0, 0, 0, . 83, 91, 0, 56, 110, 83, 117, 92, 0, 0, 1 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ DATA (JDIM(IDF),IDF=161,256) / 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 65, 43, 39, 68, 39, 41, 35, 27, 81, 1 25, 65, 129, 85, 69, 0, 0, 0, 0, 0, 5 36*0/ C C INSTALL SIMILAR TABLES FOR SPHERICAL HARMONIC COEFFICIENTS? C SAVE C 1 CONTINUE IF (IBLK.GT.0.AND.IGIB.LT.IBFCTR) GO TO 20 5 CONTINUE CALL RDTAPE (IUNIT,1,0,IBUFF,IXB) CALL IOWAIT (IUNIT,IST,IWDS) IF (IST.EQ.0.AND.IWDS.LE.IXB) GO TO 10 IF (IST.EQ.1) RETURN WRITE (6,9005) IST, IWDS, IXB 9005 FORMAT (1X,'RGRIB1 READ ERROR - IST, IWDS, IXB ',3I8) STOP 10 CONTINUE IBITS = 64 * IWDS IBLK = IBLK + 1 C C IGIB IS THE GRID NUMBER IN A BLOCK, RESET AFTER A BLOCK READ C IGIB = 0 IOFF = 0 20 CONTINUE IGIB = IGIB + 1 C C *** EXTRACT THE INDICATOR SECTION (IS / 0) OCTET C CALL GBYTE (IBUFF, TEMP,IOFF, 32) 1-4 GRIB(1:4) = TEMP(5:8) IF (GRIB(1:4).NE.'GRIB') THEN WRITE (6,9020) IBLK, IGIB, GRIB(1:4) 9020 FORMAT (1X,'RGRIB1 POSITIONING ERROR - IBLK, IGIB, GRIB ',2I5, F 1X,'.',A4,'.') GO TO 5 ENDIF CALL GBYTE (IBUFF,LENMESS,IOFF+ 32, 24) 5-7 CALL GBYTE (IBUFF, IED,IOFF+ 56, 8) 8 C IOFF = 64 C C *** EXTRACT THE PRODUCT DEFINITION SECTION (PDS / 1) OCTET C CALL GBYTE (IBUFF, LENPDS,IOFF , 24) 1-3 CALL GBYTE (IBUFF, IPTV,IOFF+ 24, 8) 4 CALL GBYTE (IBUFF, ICTR,IOFF+ 32, 8) 5 C C ICTR=7 FOR NMC/NCEP C CALL GBYTE (IBUFF, ICGEN,IOFF+ 40, 8) 6 CALL GBYTE (IBUFF, IGRID,IOFF+ 48, 8) 7 IF (IGRID.NE.255) THEN IIDIM = IDIM(IGRID+1) IJDIM = JDIM(IGRID+1) IF (IIDIM.LT.0) THEN C C FLAG INDICATING NEED FOR SPECIAL HANDLING OF ISOLATED C (NON-REPEATED) POLE POINTS C IPOLE C 1 NORTHERN HEMISPHERE POLE POINT FOLLOWS ARRAY C -1 SOUTHERN HEMISPHERE POLE POINT PRECEDES ARRAY C IF (IGRID.EQ.21.OR.IGRID.EQ.22.OR.IGRID.EQ.25.OR. I IGRID.EQ.61.OR.IGRID.EQ.62) THEN IPOLE = 1 ENDIF IF (IGRID.EQ.23.OR.IGRID.EQ.24.OR.IGRID.EQ.26.OR. I IGRID.EQ.63.OR.IGRID.EQ.64) THEN IPOLE = -1 ENDIF IIDIM = -IIDIM ELSE IPOLE = 0 ENDIF ELSE WRITE (6,9025) 9025 FORMAT(1X,'RGRIB1 FOUND A NON-TABLED GRID, WHICH SHOULD BE ' F 'DEFINED IN THE GRID DESCRIPTION SECTION') ENDIF CALL GBYTE (IBUFF, IGDS,IOFF+ 56, 1) 8 CALL GBYTE (IBUFF, IBMS,IOFF+ 57, 1) 8 C CALL GBYTE (IBUFF,IRESRV0,IOFF+ 58, 6) 8 CALL GBYTE (IBUFF, IPARM,IOFF+ 64, 8) 9 C CALL GBYTE (IBUFF,ILEVLAY,IOFF+ 72, 8) 10 CALL GBYTE (IBUFF, ILEVEL,IOFF+ 80, 16) 11-12 CALL GBYTE (IBUFF, IYR,IOFF+ 96, 8) 13 CALL GBYTE (IBUFF, IMO,IOFF+104, 8) 14 CALL GBYTE (IBUFF, IDY,IOFF+112, 8) 15 CALL GBYTE (IBUFF, IHR,IOFF+120, 8) 16 CALL GBYTE (IBUFF, IMI,IOFF+128, 8) 17 CALL GBYTE (IBUFF, IFTUN,IOFF+136, 8) 18 CALL GBYTE (IBUFF, IP1,IOFF+144, 8) 19 CALL GBYTE (IBUFF, IP2,IOFF+152, 8) 20 CALL GBYTE (IBUFF,ITIMRAN,IOFF+160, 8) 21 CALL GBYTE (IBUFF, INUM,IOFF+168, 16) 22-23 C CALL GBYTE (IBUFF,INUMMSG,IOFF+184, 8) 24 CALL GBYTE (IBUFF, ICENT,IOFF+192, 8) 25 CALL GBYTE (IBUFF,ISUBCTR,IOFF+200, 8) 26 CALL GBYTE (IBUFF, IDECS,IOFF+208, 1) 27-28 CALL GBYTE (IBUFF, IDECV,IOFF+209, 15) 27-28 IF (IDECS.EQ.1) THEN IDECF = -IDECV ELSE IDECF = IDECV ENDIF IF (LENPDS.GT.28) THEN CALL GBYTE (IBUFF,IRESRV1,IOFF+224, 96) 29-40 ENDIF IF (LENPDS.GT.40) THEN CALL GBYTE (IBUFF,IRESRV2,IOFF+320, (8*LENPDS)-320) 41-... ENDIF C IOFF = IOFF + (8 * LENPDS) C C *** EXTRACT THE GRID DESCRIPTION SECTION (GDS / 2) "OPTIONAL" OCTET C (PROVIDES A GRID DESCRIPTION FOR GRIDS NOT DEFINED BY C NUMBER IN TABLE B). C C WHEN THE GDS IS NOT INCLUDED IN A MESSAGE THEN ANY WIND COMPONENTS C ARE ASSUMED TO BE RESOLVED RELATIVE TO THE GRID SPECIFIED IN THE C PDS WITH U AND V DEFINED AS POSITIVE IN THE DIRECTION OF INCREASING C X AND Y (OR I AND J) COORDINATES RESPECTIVELY. C IF (IGDS.EQ.1) THEN C C IGRID.EQ.255 C CALL GBYTE (IBUFF, LENGDS,IOFF, 24) 1-3 CALL GBYTE (IBUFF, IGNV,IOFF+ 24, 8) 4 CALL GBYTE (IBUFF, IPVPL,IOFF+ 32, 8) 5 CALL GBYTE (IBUFF, IGREP,IOFF+ 40, 8) 6 C IOFF = IOFF + (8 * LENGDS) C ENDIF C C *** EXTRACT THE BIT MAP SECTION (BMS / 3) "OPTIONAL" OCTET C IF (IBMS.EQ.1) THEN CALL GBYTE (IBUFF, LENBMS,IOFF, 24) 1-3 CALL GBYTE (IBUFF,IUNUSE3,IOFF+ 24, 8) 4 CALL GBYTE (IBUFF, IBMAP,IOFF+ 32, 16) 5-6 IF (IBMAP.EQ.0) THEN IBLEN = 8 * (LENBMS - 6) CALL GBYTES (IBUFF,IBITMAP,IOFF+48, 1,0,IBLEN) 7-nnn ELSE WRITE (6,9030) IBLK, IGIB, IBMAP 9030 FORMAT (/1X,'RGRIB1 HAS DETECTED THE NEED FOR A SEPARATELY', F ' SUPPLIED BITMAP IN BLOCK, GRID, IBMAP',I6,2I4) ENDIF C IOFF = IOFF + (8 * LENBMS) C ENDIF C C *** EXTRACT THE BINARY DATA SECTION (BDS / 4) OCTET C (RECONSTRUCTION OF ORIGINAL GRID VALUES WILL BE DONE IN UGRIB1) C CALL GBYTE (IBUFF, LENBDS,IOFF, 24) 1-3 CALL GBYTE (IBUFF, IFLAG1,IOFF+ 24, 1) 4 CALL GBYTE (IBUFF, IFLAG2,IOFF+ 25, 1) 4 CALL GBYTE (IBUFF, IFLAG3,IOFF+ 26, 1) 4 C C IFLAG3 ORIGINAL DATA WERE C 0 FLOATING POINT C *** 1 INTEGER *** WE WILL BE FLOATING THESE... C CALL GBYTE (IBUFF, IFLAG4,IOFF+ 27, 1) 4 C C IFLAG4 FLAGS IN LAST OCTET? C 0 NO C 1 YES, MEANING WE MAY HAVE SUB-SECTIONS C CALL GBYTE (IBUFF,IUNUSE4,IOFF+ 28, 4) 4 CALL GBYTE (IBUFF, IBINF,IOFF+ 32, 16) 5-6 IF (IBINF.GT.32768) IBINF = 32768 - IBINF CALL GBYTE (IBUFF, IREFS,IOFF+ 48, 1) 7-10 CALL GBYTE (IBUFF, IREFC,IOFF+ 49, 7) 7-10 CALL GBYTE (IBUFF, IREFM,IOFF+ 56, 24) 7-10 C M24 = -24 IF (IREFS.EQ.1) THEN RS = -1. ELSE RS = 1. ENDIF REFMIN = RS * (2.**M24) * FLOAT(IREFM) * (16.**(IREFC-64)) CALL GBYTE (IBUFF,IPTBITS,IOFF+ 80, 8) 11 IF (IPTBITS.EQ.0) THEN C C WE HAVE A FLAT FIELD, I.E. ALL PACKED DATA VALUES 0, PERHAPS C INDICATING A MISSING FIELD? C WRITE (6,9000) IBLK, IGIB, IUNUSE4, IPTBITS 9000 FORMAT (/1X,'RGRIB1 FOUND A FLAT FIELD', F /6X,'IBLK, IGIB, IUNUSE4, IPTBITS ',I6,3I4) ENDIF IPOINTS = IJDM + 1 IF (MOD(IPOINTS,2).NE.0) IPOINTS = IPOINTS + 1 ISTREAM = IPOINTS * IPTBITS C C THE PACKED DATA VALUES ARE UNPACKED IN UGRIB1 12-nnn C THEY ARE FOLLOWED BY 0 PADDING TO AN EVEN NUMBER OF OCTETS (13) C ISTART POINTS UGRIB1 TO BDS OCTET 12 C ISTART = IOFF + 88 IOCT14 = ISTART + (IJJ*IPTBITS) + IUNUSE4 C C CALL GBYTE (IBUFF,IFLAGE1,IOFF+ , 1) 14 C CALL GBYTE (IBUFF,IFLAGE2,IOFF+ , 1) 14 C CALL GBYTE (IBUFF,IFLAGE3,IOFF+ , 1) 14 C CALL GBYTE (IBUFF,IFLAGE4,IOFF+ , 1) 14 C CALL GBYTE (IBUFF,IFLAGE5,IOFF+ , 1) 14 C CALL GBYTE (IBUFF,IFLAGE6,IOFF+ , 1) 14 C CALL GBYTE (IBUFF,IFLAGE7,IOFF+ , 1) 14 C CALL GBYTE (IBUFF,IFLAGE8,IOFF+ , 1) 14 C C *** EXTRACT THE END OF MESSAGE MARK ('7777') OCTET C SUCH A PATTERN COULD EXIST ANYWHERE AND SHOULD NOT BE USED AS C A SEARCH TARGET. C IOFF = IOFF + (8 * LENBDS) C CALL GBYTE (IBUFF, TEMP,IOFF, 32) 1 FOUR7S(1:4) = TEMP(5:8) IF (FOUR7S(1:4).NE.'7777') THEN WRITE (6,9077) 9077 FORMAT(1X,'RGRIB1 DID NOT HIT THE END OF GRID MARK 7777') ENDIF IOFF = IOFF + 32 RETURN END SUBROUTINE UGRIB1 (IBUFF,DATA,NERR) C C UNPACKS GRIB1 SIMPLY PACKED GRID DATA POINTS WHICH WERE READ BY RGRIB1. C C *** IT HAS NOT BEEN TESTED ON ALL POSSIBLE GRIB1 SIMPLY PACKED GRIDS C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C IBUFF THE BUFFER AS READ BY RGRIB1. C DATA AN ARRAY TO RECEIVE THE UNPACKED AND FLOATED VALUES, AND C MUST BE DIMENSIONED APPROPRIATELY FOR THE GRID C JJDM LENGTH OF DATA C NERR STATUS WHERE NONZERO VALUE INDICATES THAT IBUFF HAS BEEN C CHANGED BY USER AFTER READ OR THEIR WAS A BAD READ. C IOFF (COMMON BLOCK GRIBIS) IS BIT OFFSET TO NEXT GRID WHEN MORE C THAN ONE GRID IS PACKED IN IBUFF C IFLAG3 (COMMON BLOCK GRIBBDS) IS C 0 - FLOATING POINT C *** 1 - INTEGER *** WE WILL BE FLOATING THESE... C DIMENSION IBUFF(1), DATA(1) C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C COMMON / GRIBGDS / LENGDS, IGNV, IPVPL, IGREP C COMMON / GRIBBMS / LENBMS, IUNUSE3, IBMAP, XMSG, IBITMAP(500000) C COMMON / GRIBBDS / LENBDS, IFLAG1, IFLAG2, IFLAG3, IFLAG4, 2 ISTART, IUNUSE4, IBINF, REFMIN, IPTBITS, IFLAGE C SAVE C NERR = 0 IJJ = (IIDIM * IJDIM) + IABS(IPOLE) CALL GBYTES (IBUFF,DATA,ISTART,IPTBITS,0,IJJ) C C UNPACK VALUES (WE'RE GOING TO FLOAT THE INTEGER DATA TO C KEEP THINGS SIMPLER) C BIN = 2.**IBINF JDECF = -IDECF FACT = 10.**JDECF C C WRITE (6,9000) IFLAG4, IBINF, BIN, IDECF, FACT, IOFF, c W ISTART, IPTBITS, IJJ 9000 FORMAT (/1X,'UGRIB BDS VALS: IFLAG4, IBINF, BIN, ', F 'IDECF, FACT, IOFF, ISTART, IPTBITS, IJJ', F /6X,I2,2(I6,E13.6),I8,3I6) C WRITE (6,9001) IJJ, (DATA(KKK),KKK=5221,5365) 9001 FORMAT (/1X,'UGRIB1 UNPACKED ',I5, F ' POINTS, HERE ARE THE LAST 145 (OCTAL):', F 20(/3X,8(2X,O7))) C IF (IPTBITS.NE.0) THEN IF (IBMS.NE.1) THEN DO 20 I = 1, IJJ IDT = OR(DATA(I),0) DATA(I) = FACT * (REFMIN + (FLOAT(IDT) * BIN)) 20 CONTINUE ELSE KB = 0 DO 25 I = 1, IJJ IF (IBITMAP(I).EQ.1) THEN KB = KB + 1 IDT = OR(DATA(KB),0) DATA(I) = FACT * (REFMIN + (FLOAT(IDT) * BIN)) ELSE DATA(I) = XMSG ENDIF 25 CONTINUE ENDIF ELSE C C FLAT FIELD (NOT SURE IF WE NEED FACT OR IBITMAP) C IF (IBMS.NE.1) THEN DO 40 I = 1, IJJ DATA(I) = REFMIN * FACT 40 CONTINUE ELSE KB = 0 DO 45 I = 1, IJJ IF (IBITMAP(I).EQ.1) THEN C KB = KB + 1 DATA(I) = REFMIN * FACT ELSE DATA(I) = XMSG ENDIF 45 CONTINUE ENDIF ENDIF 90 CONTINUE END SUBROUTINE CGRIB1 (IBUFF,DATA,NERR) C C <<< JUST A DUMMY ROUTINE AWAITING DEVELOPMENT >>> C C UNPACK COMPLEX PACKED GRID POINTS C C *** IT HAS NOT BEEN TESTED ON ALL POSSIBLE GRIB1 COMPLEX PACKED GRIDS C C WRITTEN BY G. WALTERS - DSS / C C IBUFF THE BUFFER AS READ BY RGRIB1. C DATA AN ARRAY TO RECEIVE THE UNPACKED AND FLOATED VALUES, AND C MUST BE DIMENSIONED APPROPRIATELY FOR THE GRID C JJDM LENGTH OF DATA C NERR STATUS WHERE NONZERO VALUE INDICATES THAT IBUFF HAS BEEN C CHANGED BY USER AFTER READ OR THEIR WAS A BAD READ. C IOFF (COMMON BLOCK GRIBIS) IS BIT OFFSET TO NEXT GRID WHEN MORE C THAN ONE GRID IS PACKED IN IBUFF C IFLAG3 (COMMON BLOCK GRIBBDS) IS C 0 - FLOATING POINT C *** 1 - INTEGER *** WE WILL BE FLOATING THESE... C DIMENSION IBUFF(1), DATA(1) C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C COMMON / GRIBGDS / LENGDS, IGNV, IPVPL, IGREP C COMMON / GRIBBMS / LENBMS, IUNUSE3, IBMAP, XMSG, IBITMAP(500000) C COMMON / GRIBBDS / LENBDS, IFLAG1, IFLAG2, IFLAG3, IFLAG4, 2 ISTART, IUNUSE4, IBINF, REFMIN, IPTBITS, IFLAGE C SAVE C NERR = 9 RETURN END SUBROUTINE SGRIB1 (IBUFF,DATA,NERR) C C <<< JUST A DUMMY ROUTINE AWAITING DEVELOPMENT >>> C C UNPACK SIMPLY PACKED SPHERICAL HARMONIC COEFFICIENTS C C *** IT HAS NOT BEEN TESTED ON ALL POSSIBLE GRIB1 SIMPLY PACKED SPHERICAL C HARMONIC COEFFICIENTS C C WRITTEN BY G. WALTERS - DSS / C C IBUFF THE BUFFER AS READ BY RGRIB1. C DATA AN ARRAY TO RECEIVE THE UNPACKED AND FLOATED VALUES, AND C MUST BE DIMENSIONED APPROPRIATELY FOR THE GRID C JJDM LENGTH OF DATA C NERR STATUS WHERE NONZERO VALUE INDICATES THAT IBUFF HAS BEEN C CHANGED BY USER AFTER READ OR THEIR WAS A BAD READ. C IOFF (COMMON BLOCK GRIBIS) IS BIT OFFSET TO NEXT GRID WHEN MORE C THAN ONE GRID IS PACKED IN IBUFF C IFLAG3 (COMMON BLOCK GRIBBDS) IS C 0 - FLOATING POINT C *** 1 - INTEGER *** WE WILL BE FLOATING THESE... C DIMENSION IBUFF(1), DATA(1) C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C COMMON / GRIBGDS / LENGDS, IGNV, IPVPL, IGREP C COMMON / GRIBBMS / LENBMS, IUNUSE3, IBMAP, XMSG, IBITMAP(500000) C COMMON / GRIBBDS / LENBDS, IFLAG1, IFLAG2, IFLAG3, IFLAG4, 2 ISTART, IUNUSE4, IBINF, REFMIN, IPTBITS, IFLAGE C SAVE C NERR = 9 RETURN END SUBROUTINE XGRIB1 (IBUFF,DATA,NERR) C C <<< JUST A DUMMY ROUTINE AWAITING DEVELOPMENT >>> C C UNPACK COMPLEX SPHERICAL HARMONIC COEFFICIENTS C C *** IT HAS NOT BEEN TESTED ON ALL POSSIBLE GRIB1 COMPLEX PACKED SPHERICAL C HARMONIC COEFFICIENTS C C WRITTEN BY G. WALTERS - DSS / C C IBUFF THE BUFFER AS READ BY RGRIB1. C DATA AN ARRAY TO RECEIVE THE UNPACKED AND FLOATED VALUES, AND C MUST BE DIMENSIONED APPROPRIATELY FOR THE GRID C JJDM LENGTH OF DATA C NERR STATUS WHERE NONZERO VALUE INDICATES THAT IBUFF HAS BEEN C CHANGED BY USER AFTER READ OR THEIR WAS A BAD READ. C IOFF (COMMON BLOCK GRIBIS) IS BIT OFFSET TO NEXT GRID WHEN MORE C THAN ONE GRID IS PACKED IN IBUFF C IFLAG3 (COMMON BLOCK GRIBBDS) IS C 0 - FLOATING POINT C *** 1 - INTEGER *** WE WILL BE FLOATING THESE... C DIMENSION IBUFF(1), DATA(1) C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C COMMON / GRIBGDS / LENGDS, IGNV, IPVPL, IGREP C COMMON / GRIBBMS / LENBMS, IUNUSE3, IBMAP, XMSG, IBITMAP(500000) C COMMON / GRIBBDS / LENBDS, IFLAG1, IFLAG2, IFLAG3, IFLAG4, 2 ISTART, IUNUSE4, IBINF, REFMIN, IPTBITS, IFLAGE C SAVE C NERR = 9 RETURN END SUBROUTINE NAMEIT C C CALL THE VARIOUS ROUTINES NEEDED TO MAP THE GRIB1 CODES C FOR THE CENTER, SUB-CENTER, GENERATING MODEL, GRID, PARAMETER C AND TIME RANGE. C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C COMMON / GRIBGDS / LENGDS, IGNV, IPVPL, IGREP C COMMON / GRIBBMS / LENBMS, IUNUSE3, IBMAP, XMSG, IBITMAP(500000) C COMMON / GRIBBDS / LENBDS, IFLAG1, IFLAG2, IFLAG3, IFLAG4, 2 ISTART, IUNUSE4, IBINF, REFMIN, IPTBITS, IFLAGE C CHARACTER*3 MONS(12) DATA MONS / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', / 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/ C CHARACTER*64 CCTR, CSCTR, CCGEN, CGREP, CGRID, 2 CPARM, CLEVL CHARACTER CTIMRN*8, CTIMRN1*88 COMMON / NAMES / CCTR, CSCTR, CCGEN, CGREP, CGRID, 2 CPARM, CLEVL, CTIMRN, CTIMRN1 C SAVE C CALL NCENTM (ICTR,CCTR) CSCTR(01:32) = ' ' CSCTR(33:64) = ' ' IF (ICTR.EQ.7) THEN CALL NCENT7 (ISUBCTR,CSCTR) ENDIF IF (ICTR.EQ.9) THEN CALL NCENT9 (ISUBCTR,CSCTR) ENDIF CCGEN(01:32) = ' ' CCGEN(33:64) = ' ' CALL NCGENM (ICGEN,CCGEN) CGREP(01:32) = ' ' CGREP(33:64) = ' ' IF (IGDS.NE.0) THEN CALL NCGREPM (IGREP,CGREP) ELSE CGREP(01:32) = 'NO GRID DESCRIPTION SECTION ' IGREP = 255 ENDIF CGRID(01:32) = ' ' CGRID(33:64) = ' ' CALL NGRIDM (IGRID,CGRID) CPARM(01:32) = ' ' CPARM(33:64) = ' ' CALL NPARMM (IPARM,CPARM) CLEVL(01:32) = ' ' CLEVL(33:64) = ' ' CALL NLEVLM (ILEVLAY,ILEVEL,CLEVL,IDO) RETURN END SUBROUTINE NCENTM (ICTR,CCTR) C C MAP THE GRIB1 ICTR CODE TO A VERBAL STRING C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER CCTR*(*) CHARACTER*64 NCTR(256) C DATA NCTR(07)(01:60) / / 'USWS - NATIONAL CENTER FOR ENVIRONMENTAL PREDICTION '/ DATA NCTR(08)(01:60) / / 'USWS - NWS TELECOMMUNICATIONS GATEWAY '/ DATA NCTR(09)(01:60) / / 'USWS - FIELD STATIONS '/ DATA NCTR(34)(01:60) / / 'JAPANESE METEOROLOGICAL AGENCY - TOKYO '/ DATA NCTR(52)(01:60) / / 'USWS - NATIONAL HURRICANE CENTER, MIAMI '/ DATA NCTR(54)(01:60) / / 'CANADIAN METEOROLOGICAL SERVICE - MONTREAL '/ DATA NCTR(57)(01:60) / / 'USAF - GLOBAL WEATHER CENTER '/ DATA NCTR(58)(01:60) / / 'USN - FLEET NUMERICAL OCEANOGRAPGY CENTER '/ DATA NCTR(59)(01:60) / / 'US NOAA - FORECAST SYSTEMS LAB - BOULDER, CO '/ DATA NCTR(74)(01:60) / / 'UK METEOROLOGICAL OFFICE - BRACKNELL '/ DATA NCTR(85)(01:60) / / 'FRENCH WEATHER SERVICE - TOULOUSE '/ DATA NCTR(97)(01:60) / / 'EUROPEAN SPACE AGENCY '/ DATA NCTR(98)(01:60) / / 'EUROPEAN CENTER FOR MEDIUM-RANGE WEATHER FORECASTS - READING'/ DATA NCTR(99)(01:60) / / 'DEBILT, NETHERLANDS '/ C SAVE C CCTR(01:32) = ' ' CCTR(33:64) = ' ' C IDO = 0 IF (ICTR.GE. 7.AND.ICTR.LE. 9) IDO = 1 IF (ICTR.EQ.34) IDO = 1 IF (ICTR.EQ.52) IDO = 1 IF (ICTR.EQ.54) IDO = 1 IF (ICTR.GE.57.AND.ICTR.LE.59) IDO = 1 IF (ICTR.EQ.74) IDO = 1 IF (ICTR.EQ.85) IDO = 1 IF (ICTR.GE.97.AND.ICTR.LE.99) IDO = 1 C IF (IDO.EQ.1) THEN CCTR(01:60) = NCTR(ICTR)(01:60) ENDIF RETURN END SUBROUTINE NCENT7 (ISUBCTR,CSCTR) C C MAP THE GRIB1 ICTR=7 ISUBCTR CODE TO A VERBAL STRING C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER CSCTR*(*) CHARACTER*64 NSCTR(256) C DATA NSCTR(001)(01:60) / / 'NCEP NMC RE-ANALYSIS PROJECT '/ C SAVE C CSCTR(01:32) = ' ' CSCTR(33:64) = ' ' C IDO = 0 IF (ISUBCTR.EQ. 1) IDO = 1 C IF (IDO.EQ.1) THEN CSCTR(01:60) = NSCTR(ISUBCTR)(01:60) ENDIF END SUBROUTINE NCENT9 (ISUBCTR,CSCTR) C C MAP THE GRIB1 ICTR=9 ISUBCTR CODE TO A VERBAL STRING C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER CSCTR*(*) CHARACTER*64 NSCTR(256) C DATA NSCTR(150)(01:60) / / 'ABRFC - ARKANSAS-RED RIVER RFC, TULSA OK '/ DATA NSCTR(151)(01:60) / / 'ALASKA RFC, ANCHORAGE, AK '/ DATA NSCTR(152)(01:60) / / 'CBRFC - COLORADO BASIN RFC, SALT LAKE CITY, UT '/ DATA NSCTR(153)(01:60) / / 'CNRFC - CALIFORNIA-NEVADA RFC, SACRAMENTO, CA '/ DATA NSCTR(154)(01:60) / / 'LMRFC - LOWER MISSISSIPPI RFC, SLIDEL, LA '/ DATA NSCTR(155)(01:60) / / 'MARFC - MIDDLE ATLANTIC RFC, STATE COLLEGE, PA '/ DATA NSCTR(156)(01:60) / / 'MBRFC - MISSOURI BASIN RFC, KANSAS CITY, MO '/ DATA NSCTR(157)(01:60) / / 'NCRFC - NORTH CENTRAL RFC, MINNEAPOLIS, MN '/ DATA NSCTR(158)(01:60) / / 'NERFC - NORTHEAST RFC, HARTFORD, CT '/ DATA NSCTR(159)(01:60) / / 'NWRFC - NORTHWEST RFC, PORTLAND, OR '/ DATA NSCTR(160)(01:60) / / 'OHRFC - OHIO BASIN RFC, CINCINNATI, OH '/ DATA NSCTR(161)(01:60) / / 'SERFC - SOUTHEAST RFC, ATLANTA, GA '/ DATA NSCTR(162)(01:60) / / 'WGRFC - WEST GULF RFC, FORT WORTH, TX '/ DATA NSCTR(170)(01:60) / / 'OUN - NORMAN OK WFO '/ C SAVE C CSCTR(01:32) = ' ' CSCTR(33:64) = ' ' C IDO = 0 IF (ISUBCTR.GE.150.OR.ISUBCTR.LE.162) IDO = 1 IF (ISUBCTR.EQ.170) IDO = 1 C IF (IDO.EQ.1) THEN CSCTR(01:60) = NSCTR(ISUBCTR)(01:60) ENDIF RETURN END SUBROUTINE NCGENM (ICGEN,CCGEN) C C MAP THE GRIB1 ICGEN CODE TO A VERBAL STRING C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER CCGEN*(*) CHARACTER*64 NCGEN(256) C DATA NCGEN(002)(01:60) / / 'ULTRA VIOLET POTENTIAL INDEX MODEL '/ DATA NCGEN(005)(01:60) / / 'SATELLITE DERIVED PRECIP AND TEMPS, FROM IR (NAMED IN PDS 41'/ DATA NCGEN(010)(01:60) / / 'GLOBAL WIND-WAVE FORECAST MODEL '/ DATA NCGEN(019)(01:60) / / 'LIMITED-AREA FINE MESH (LFM) ANALYSIS '/ DATA NCGEN(025)(01:60) / / 'SNOW COVER ANALYSIS '/ DATA NCGEN(039)(01:60) / / 'NESTED GRID FORECAST MODEL (NGM) '/ DATA NCGEN(042)(01:60) / / 'GLOBAL OPTIMUM INTERPOLATION ANALYSIS (GOI), "AVIATION" RUN '/ DATA NCGEN(043)(01:60) / / 'GLOBAL OPTIMUM INTERPOLATION ANALYSIS (GOI), "FINAL" RUN '/ DATA NCGEN(044)(01:60) / / 'SEA SURFACE TEMPERATURE ANALYSIS '/ DATA NCGEN(049)(01:60) / / 'OZONE ANALYSIS FROM TIROS OBSERVATIONS '/ DATA NCGEN(052)(01:60) / / 'OZONE ANALYSIS FROM NIMBUS 7 OBSERVATIONS '/ DATA NCGEN(053)(01:60) / / 'LFM-FOURTH ORDER FORECAST MODEL '/ DATA NCGEN(064)(01:60) / / 'REGIONAL OPTIMUM INTERPOLATION ANALYSIS (ROI) '/ DATA NCGEN(068)(01:60) / / '80 WAVE TRIANGULAR, 18-LAYER SPECTRAL MODEL, "AVIATION" RUN '/ DATA NCGEN(069)(01:60) / / '80 WAVE TRIANGULAR, 18 LAYER SPECTRAL MODEL, "MRF" RUN '/ DATA NCGEN(070)(01:60) / / 'QUASI-LAGRANGIAN HURRICANE MODEL (QLM) '/ DATA NCGEN(073)(01:60) / / 'FOG FORECAST MODEL - OCEAN PROD. CENTER '/ DATA NCGEN(074)(01:60) / / 'GULF OF MEXICO WIND/WAVE '/ DATA NCGEN(075)(01:60) / / 'GULF OF ALASKA WIND/WAVE '/ DATA NCGEN(076)(01:60) / / 'BIAS CORRECTED MEDIUM RANGE FORECAST (MRF) '/ DATA NCGEN(077)(01:60) / / '126 WAVE TRIANGULAR, 28 LAYER SPECTRAL MODEL, "AVIATION" RUN'/ DATA NCGEN(078)(01:60) / / '126 WAVE TRIANGULAR, 28 LAYER SPECTRAL MODEL, "MRF" RUN '/ DATA NCGEN(079)(01:60) / / 'BACKUP FROM THE PREVIOUS RUN '/ DATA NCGEN(080)(01:60) / / '62 WAVE TRIANGULAR, 18 LAYER SPECTRAL MODEL, "MRF" RUN '/ DATA NCGEN(081)(01:60) / / 'SPECTRAL STATISTICAL INTERP (SSI) ANALYSIS "AVIATION" RUN. '/ DATA NCGEN(082)(01:60) / / 'SPECTRAL STATISTICAL INTERP (SSI) ANALYSIS "FINAL" RUN. '/ DATA NCGEN(083)(01:60) / / 'ETA MODEL - 80 KM VERSION '/ DATA NCGEN(084)(01:60) / / 'ETA MODEL - 40 KM VERSION '/ DATA NCGEN(085)(01:60) / / 'ETA MODEL - 30 KM VERSION '/ DATA NCGEN(086)(01:60) / / 'RUC/MAPS ISENTROPIC MODEL, FORECAST SYSTEMS LAB (60KM:40N) '/ DATA NCGEN(087)(01:60) / / 'CAC ENSEMBLE FORECASTS FROM SPECTRAL (ENSMB) '/ DATA NCGEN(088)(01:60) / / 'OCEAN WAVE MODEL WITH ADDITIONAL PHYSICS (PWAV) '/ DATA NCGEN(150)(01:60) / / 'NWS RIVER FORECAST SYSTEM (NWSRFS) '/ DATA NCGEN(151)(01:60) / / 'NWS FLASH FLOOD GUIDANCE SYSTEM (NWSFFGS) '/ DATA NCGEN(152)(01:60) / / 'WSR-88D STAGE II PRECIPITATION ANALYSIS '/ DATA NCGEN(153)(01:60) / / 'WSR-88D STAGE III PRECIPITATION ANALYSIS '/ C SAVE C CCGEN(01:32) = ' ' CCGEN(33:64) = ' ' IDO = 0 IF (ICGEN.EQ. 2) IDO = 1 IF (ICGEN.EQ. 5) IDO = 1 IF (ICGEN.EQ. 10) IDO = 1 IF (ICGEN.EQ. 19) IDO = 1 IF (ICGEN.EQ. 25) IDO = 1 IF (ICGEN.EQ. 39) IDO = 1 IF (ICGEN.GE. 42.AND.ICGEN.LE. 44) IDO = 1 IF (ICGEN.EQ. 49) IDO = 1 IF (ICGEN.EQ. 52) IDO = 1 IF (ICGEN.EQ. 53) IDO = 1 IF (ICGEN.EQ. 64) IDO = 1 IF (ICGEN.GE. 68.AND.ICGEN.LE. 70) IDO = 1 IF (ICGEN.GE. 73.AND.ICGEN.LE. 88) IDO = 1 IF (ICGEN.GE.150.AND.ICGEN.LE.153) IDO = 1 IF (IDO.EQ.1) THEN CCGEN(01:60) = NCGEN(ICGEN)(01:60) ENDIF RETURN END SUBROUTINE NGRIDM (IGRID,CGRID) C C MAP THE GRIB1 IGRID CODE TO A VERBAL STRING C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C C NOTE THAT THESE NAMES ARE BASED ON NCEP DOCUMENTATION AND C PRACTISE - ECMWF HAS NOT ADHERED TO THE WMO CODES... C CHARACTER CGRID*(*) CHARACTER*64 NGRID(256) C DATA NGRID(001)(01:60) / / 'NCEP 73X23 TROPICAL MERCATOR; 48.09S-48.09N '/ DATA NGRID(002)(01:60) / / 'NCEP 144X73 2.5DEGR GLOBAL; 90N-90S; LONGITUDE/LATITUDE '/ DATA NGRID(003)(01:60) / / 'NCEP 360X181 1.0DEGR GLOBAL; 90N-90S; LONGITUDE/LATITUDE '/ DATA NGRID(004)(01:60) / / 'NCEP 720X361 0.5DEGR GLOBAL; 90N-90S; LONGITUDE/LATITUDE '/ DATA NGRID(005)(01:60) / / 'NCEP 53X57 NORTHERN HEMISPHERE POLAR STEREOGRAPHIC (LFM) '/ DATA NGRID(006)(01:60) / / 'NCEP 53X45 NORTHERN HEMISPHERE POLAR STEREOGRAPHIC (LFM) '/ C DATA NGRID(021)(01:60) / / 'INTNL EXCHG 37X36 +POLE; 5.0X2.5; 0-180E, 0-90N '/ DATA NGRID(022)(01:60) / / 'INTNL EXCHG 37X36 +POLE; 5.0X2.5; 180W-0, 0-90N '/ DATA NGRID(023)(01:60) / / 'INTNL EXCHG POLE+ 37X36; 5.0X2.5; 0-180E, 90S-0 '/ DATA NGRID(024)(01:60) / / 'INTNL EXCHG POLE+ 37X36; 5.0X2.5; 180W-0, 90S-0 '/ DATA NGRID(025)(01:60) / / 'INTNL EXCHG 37X36 +POLE; 5.0X5.0; 0-355E, 0-90N '/ DATA NGRID(026)(01:60) / / 'INTNL EXCHG POLE+ 37X36; 5.0X5.0; 0-355E, 90S-0 '/ C DATA NGRID(027)(01:60) / / 'NCEP 65X65 NORTHERN HEMISPHERE POLAR STEREOGRAPHIC (80W) '/ DATA NGRID(028)(01:60) / / 'NCEP 65X65 SOUTHERN HEMISPHERE POLAR STEREOGRAPHIC (100E) '/ DATA NGRID(029)(01:60) / / 'NCEP 145X37 2.5DEGR NORTHERN HEMISPHERE LONGITUDE/LATITUDE '/ DATA NGRID(030)(01:60) / / 'NCEP 145X37 2.5DEGR SOUTHERN HEMISPHERE LONGITUDE/LATITUDE '/ DATA NGRID(033)(01:60) / / 'NCEP 181X46 2.0DEGR NORTHERN HEMISPHERE LONGITUDE/LATITUDE '/ DATA NGRID(034)(01:60) / / 'NCEP 181X46 2.0DEGR SOUTHERN HEMISPHERE LONGITUDE/LATITUDE '/ C DATA NGRID(037)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT I:330E-060E,0-90N '/ DATA NGRID(038)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT J:060E-150E,0-90N '/ DATA NGRID(039)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT K:150E-240E,0-90N '/ DATA NGRID(040)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT L:240E-330E,0-90N '/ DATA NGRID(041)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT M:330E-060E,0-90S '/ DATA NGRID(042)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT N:060E-150E,0-90S '/ DATA NGRID(043)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT O:150E-240E,0-90S '/ DATA NGRID(044)(01:60) / / 'INTNL EXCHG QUASI 1.25DEGR GRID, OCTANT P:240E-330E,0-90S '/ DATA NGRID(050)(01:60) / / 'INTNL EXCHG QUASI 2.5X1.25DEGR GRID, US: ~130W-60W,20-60N '/ C DATA NGRID(055)(01:60) / / 'NCEP 87X71 N. HEMISPHERE POLAR STEREOGRAPHIC (2/3 BEDIENT) '/ DATA NGRID(056)(01:60) / / 'NCEP 87X71 N. HEMISPHERE POLAR STEREOGRAPHIC (1/3 BEDIENT) '/ C DATA NGRID(061)(01:60) / / 'INTNL EXCHG 91X45 +POLE; 2.0X2.0; 0-180E, 0-90N '/ DATA NGRID(062)(01:60) / / 'INTNL EXCHG 91X45 +POLE; 2.0X2.0; 180W-0, 0-90N '/ DATA NGRID(063)(01:60) / / 'INTNL EXCHG POLE+ 91X45; 2.0X2.0; 0-180E, 90S-0 '/ DATA NGRID(064)(01:60) / / 'INTNL EXCHG POLE+ 91X45; 2.0X2.0; 180W-0, 90S-0 '/ C DATA NGRID(075)(01:60) / / 'NCEP 111X111 N. HEMISPHERE LAMBERT CONFORMAL (QLM HURRICANE)'/ DATA NGRID(076)(01:60) / / 'NCEP 111X111 S. HEMISPHERE LAMBERT CONFORMAL (QLM HURRICANE)'/ DATA NGRID(077)(01:60) / / 'NCEP 111X111 N. HEMISPHERE MERCATOR (QLM HURRICANE) '/ DATA NGRID(085)(01:60) / / 'NCEP 360X90 0.5DEGR NORTHERN HEMISPHERE LONGITUDE/LATITUDE '/ DATA NGRID(086)(01:60) / / 'NCEP 360X90 0.5DEGR SOUTHERN HEMISPHERE LONGITUDE/LATITUDE '/ DATA NGRID(087)(01:60) / / 'NCEP 81X62 N. HEMISPHERE POLAR STEREOGRAPHIC (RUC) '/ DATA NGRID(090)(01:60) / / 'NCEP 92X141 N.& C. AMERICA QUASI LONG/LAT (ETA80KM UNFILLED)'/ DATA NGRID(091)(01:60) / / 'NCEP 183X141 N.& C. AMERICA QUASI LONG/LAT (ETA80KM FILLED) '/ DATA NGRID(092)(01:60) / / 'NCEP 127X191 N.& C. AMERICA QUASI LONG/LAT (ETA40KM UNFILLED'/ DATA NGRID(093)(01:60) / / 'NCEP 253X191 N.& C. AMERICA QUASI LONG/LAT (ETA40KM FILLED) '/ DATA NGRID(098)(01:60) / / 'NCEP GLOBAL GAUSSIAN T62 '/ DATA NGRID(100)(01:60) / / 'NCEP 83X83 N. HEMISPHERE POLAR STEREOGRAPHIC (NGM ORIG. C) '/ DATA NGRID(101)(01:60) / / 'NCEP 113X91 N. HEMISPHERE POLAR STEREOGRAPHIC (NGM BIG C) '/ DATA NGRID(103)(01:60) / / 'NCEP 65X56 N. HEMISPHERE POLAR STEREOGRAPHIC (ARL) '/ DATA NGRID(104)(01:60) / / 'NCEP 147X110 N. HEMISPHERE POLAR STEREOGRAPHIC (NGM SUPER C)'/ DATA NGRID(105)(01:60) / / 'NCEP 83X83 US SUBSET N. HEM. POLAR STEREO. (ETA SUPER C) '/ DATA NGRID(106)(01:60) / / 'NCEP 165X117 N. HEM. POLAR STEREO. (ETA HI-RES: 2XSUPER C) '/ DATA NGRID(107)(01:60) / / 'NCEP 120X92 N. HEM. POLAR STEREO. (ETA HI-RES & MAPS/RUC) '/ C DATA NGRID(201)(01:60) / / 'NCEP (A) 65X65 N. HEMIS. POLAR STEREOGRAPHIC (105W) (AWIPS) '/ DATA NGRID(202)(01:60) / / 'NCEP (I) 65X43 CON. US POLAR STEREOGRAPHIC (105W) (AWIPS) '/ DATA NGRID(203)(01:60) / / 'NCEP (J) 45X39 ALASKA POLAR STEREOGRAPHIC (105W) (AWIPS) '/ DATA NGRID(204)(01:60) / / 'NCEP (K) 93X68 HAWAII MERCATOR 25.0S-60.644N (AWIPS) '/ DATA NGRID(205)(01:60) / / 'NCEP (L) 45X39 PUERTO RICO POLAR STEREOGRAPHIC (60W) (AWIPS)'/ DATA NGRID(206)(01:60) / / 'NCEP (M) 51X41 CENT. US MARD LAMBERT CONFORMAL (AWIPS) '/ DATA NGRID(207)(01:60) / / 'NCEP (N) 49X35 ALASKA POLAR STEREOGRAPHIC (105W) (AWIPS) '/ DATA NGRID(208)(01:60) / / 'NCEP (O) 29X27 HAWAII MERCATOR 9.343N-28.092N (AWIPS) '/ DATA NGRID(209)(01:60) / / 'NCEP (S) 101X81 CENT. US MARD LAMBERT CONFORMAL (AWIPS) '/ DATA NGRID(210)(01:60) / / 'NCEP (P) 25X25 PUERTO RICO MERCATOR 9.0N-26.422N (AWIPS) '/ DATA NGRID(211)(01:60) / / 'NCEP (Q) 93X65 CON. US LAMBERT CONFORMAL (AWIPS) '/ DATA NGRID(212)(01:60) / / 'NCEP (R) 185X129 CON. US LAMBERT CONFORMAL (AWIPS) '/ DATA NGRID(213)(01:60) / / 'NCEP (H) 129X85 CON. US POLAR STEREOGRAPHIC (105W) (AWIPS) '/ DATA NGRID(214)(01:60) / / 'NCEP (T) 97X69 ALASKA POLAR STEREOGRAPHIC (105W) (AWIPS) '/ C DATA NGRID(255)(01:60) / / 'NON-DEFINED GRID - SPECIFIED IN THE GDS '/ C SAVE C CGRID(01:32) = ' ' CGRID(33:64) = ' ' IDO = 0 IF (IGRID.GE. 1.AND.IGRID.LE. 6) IDO = 1 IF (IGRID.GE. 21.AND.IGRID.LE. 30) IDO = 1 IF (IGRID.GE. 33.AND.IGRID.LE. 34) IDO = 1 IF (IGRID.GE. 37.AND.IGRID.LE. 44) IDO = 1 IF (IGRID.EQ. 50) IDO = 1 IF (IGRID.GE. 55.AND.IGRID.LE. 56) IDO = 1 IF (IGRID.GE. 61.AND.IGRID.LE. 64) IDO = 1 IF (IGRID.GE. 75.AND.IGRID.LE. 77) IDO = 1 IF (IGRID.GE. 85.AND.IGRID.LE. 87) IDO = 1 IF (IGRID.GE. 90.AND.IGRID.LE. 93) IDO = 1 IF (IGRID.EQ. 98) IDO = 1 IF (IGRID.GE.100.AND.IGRID.LE.101) IDO = 1 IF (IGRID.GE.103.AND.IGRID.LE.107) IDO = 1 IF (IGRID.GE.201.AND.IGRID.LE.214) IDO = 1 IF (IDO.EQ.1) THEN CGRID(01:60) = NGRID(IGRID)(01:60) ENDIF RETURN END SUBROUTINE NCGREPM (IGREP,CGREP) C C MAP THE GRIB1 IGREP CODE TO A VERBAL STRING C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C C NOTE THAT THESE NAMES ARE BASED ON NCEP DOCUMENTATION AND C PRACTISE - ECMWF HAS NOT ADHERED TO THE WMO CODES... C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C CHARACTER CGREP*(*) CHARACTER*64 NGREP(256) C DATA NGREP(001)(01:60) / / 'LATITUDE/LONGITUDE (EQUIDISTANT CYLINDRICAL OR PLATE CARREE)'/ DATA NGREP(002)(01:60) / / 'MERCATOR '/ DATA NGREP(003)(01:60) / / 'GNOMONIC '/ DATA NGREP(004)(01:60) / / 'LAMBERT CONFORMAL (SECANT OR TANGENT, CONICAL OR BIPOLAR) '/ DATA NGREP(005)(01:60) / / 'GAUSSIAN LATITUDE/LONGITUDE '/ DATA NGREP(006)(01:60) / / 'POLAR STEREOGRAPHIC '/ C DATA NGREP(014)(01:60) / / 'OBLIQUE LAMBERT CONFORMAL (SECANT OR TANGENT, CONICAL OR BIP'/ C DATA NGREP(051)(01:60) / / 'SPHERICAL HARMONIC COEFFICIENTS '/ C DATA NGREP(091)(01:60) / / 'SPACE VIEW PERSPECTIVE OR ORTHOGRAPHIC '/ C DATA NGREP(202)(01:60) / / 'ARAKAWA SEMI-STAGGERED E-GRID ON ROTATED LATITUDE/LONGITUDE '/ DATA NGREP(203)(01:60) / / 'ARAKAWA FILLED E-GRID ON ROTATED LATITUDE/LONGITUDE '/ C SAVE C CGREP(01:32) = ' ' CGREP(33:64) = ' ' IDO = 0 IF (IGDS.EQ.0) RETURN IF (IGREP.GE. 0.AND.IGREP.LE. 5) IDO = 1 IF (IGREP.EQ. 13) IDO = 1 IF (IGREP.EQ. 50) IDO = 1 IF (IGREP.EQ. 90) IDO = 1 IF (IGREP.GE.201.AND.IGREP.LE.202) IDO = 1 IF (IDO.EQ.1) THEN CGREP(01:60) = NGREP(IGREP+1)(01:60) ENDIF RETURN END SUBROUTINE NPARMM (IPARM,CPARM) C C MAP THE GRIB1 PARAMETER (/UNIT) CODE TO A VERBAL STRING C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER CPARM*(*) CHARACTER*64 NPARM(256) C DATA NPARM(001)(01:60) / / 'PRESSURE PA PRES '/ DATA NPARM(002)(01:60) / / 'PRESSURE REDUCED TO MSL PA PRMSL '/ DATA NPARM(003)(01:60) / / 'PRESSURE TENDENCY PA/S PTEND '/ DATA NPARM(004)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(005)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(006)(01:60) / / 'GEOPOTENTIAL M2/S2 GP '/ DATA NPARM(007)(01:60) / / 'GEOPOTENTIAL HEIGHT GPM HGT '/ DATA NPARM(008)(01:60) / / 'GEOMETRIC HEIGHT M DIST '/ DATA NPARM(009)(01:60) / / 'STANDARD DEVIATION OF HEIGHT M HSTDV '/ DATA NPARM(010)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(011)(01:60) / / 'TEMPERATURE K TMP '/ DATA NPARM(012)(01:60) / / 'VIRTUAL TEMPERATURE K VTMP '/ DATA NPARM(013)(01:60) / / 'POTENTIAL TEMPERATURE K POT '/ DATA NPARM(014)(01:60) / / 'PSEUDO-ADIAB. POT.TEMP. OR EQ.POT.TEMP. K EPOT '/ DATA NPARM(015)(01:60) / / 'MAXIMUM TEMPERATURE K T MAX '/ DATA NPARM(016)(01:60) / / 'MINIMUM TEMPERATURE K T MIN '/ DATA NPARM(017)(01:60) / / 'DEW POINT TEMPERATURE K DPT '/ DATA NPARM(018)(01:60) / / 'DEW POINT DEPRESSION (OR DEFICIT) K DEPR '/ DATA NPARM(019)(01:60) / / 'LAPSE RATE K/M LAPR '/ DATA NPARM(020)(01:60) / / 'VISIBILITY M VIS '/ DATA NPARM(021)(01:60) / / 'RADAR SPECTRA (1) - RDSP1 '/ DATA NPARM(022)(01:60) / / 'RADAR SPECTRA (2) - RDSP2 '/ DATA NPARM(023)(01:60) / / 'RADAR SPECTRA (3) - RDSP3 '/ DATA NPARM(024)(01:60) / / 'TOTAL OZONE DOBSON UN TOTO3 '/ DATA NPARM(025)(01:60) / / 'TEMPERATURE ANOMALY K TMP A '/ DATA NPARM(026)(01:60) / / 'PRESSURE ANOMALY PA PRESA '/ DATA NPARM(027)(01:60) / / 'GEOPOTENTIAL HEIGHT ANOMALY GPM GP A '/ DATA NPARM(028)(01:60) / / 'WAVE SPECTRA (1) - WVSP1 '/ DATA NPARM(029)(01:60) / / 'WAVE SPECTRA (2) - WVSP2 '/ DATA NPARM(030)(01:60) / / 'WAVE SPECTRA (3) - WVSP3 '/ DATA NPARM(031)(01:60) / / 'WIND DIRECTION (FROM WHICH BOWLING) DEG TRUE WDIR '/ DATA NPARM(032)(01:60) / / 'WIND SPEED M/S WIND '/ DATA NPARM(033)(01:60) / / 'U-COMPONENT OF WIND M/S U GRD '/ DATA NPARM(034)(01:60) / / 'V-COMPONENT OF WIND M/S V GRD '/ DATA NPARM(035)(01:60) / / 'STREAM FUNCTION M2/S STRM '/ DATA NPARM(036)(01:60) / / 'VELOCITY POTENTIAL M2/S V POT '/ DATA NPARM(037)(01:60) / / 'MONTGOMERY STREAM FUNCTION M2/S2 MNTSF '/ DATA NPARM(038)(01:60) / / 'SIGMA COORD. VERTICAL VELOCITY /S SGCVV '/ DATA NPARM(039)(01:60) / / 'PRESSURE VERTICAL VELOCITY PA/S V VEL '/ DATA NPARM(040)(01:60) / / 'GEOMETRIC VERTICAL VELOCITY M/S DZDT '/ DATA NPARM(041)(01:60) / / 'ABSOLUTE VORTICITY /S ABS V '/ DATA NPARM(042)(01:60) / / 'ABSOLUTE DIVERGENCE /S ABS D '/ DATA NPARM(043)(01:60) / / 'RELATIVE VORTICITY /S REL V '/ DATA NPARM(044)(01:60) / / 'RELATIVE DIVERGENCE /S REL D '/ DATA NPARM(045)(01:60) / / 'VERTICAL U-COMPONENT SHEAR /S VUCSH '/ DATA NPARM(046)(01:60) / / 'VERTICAL V-COMPONENT SHEAR /S VVCSH '/ DATA NPARM(047)(01:60) / / 'DIRECTION OF CURRENT DEG TRUE DIR C '/ DATA NPARM(048)(01:60) / / 'SPEED OF CURRENT M/S SP C '/ DATA NPARM(049)(01:60) / / 'U-COMPONENT OF CURRENT M/S UOGRD '/ DATA NPARM(050)(01:60) / / 'V-COMPONENT OF CURRENT M/S VOGRD '/ DATA NPARM(051)(01:60) / / 'SPECIFIC HUMIDITY KG/KG SPF H '/ DATA NPARM(052)(01:60) / / 'RELATIVE HUMIDITY % R H '/ DATA NPARM(053)(01:60) / / 'HUMIDITY MIXING RATIO KG/KG MIXR '/ DATA NPARM(054)(01:60) / / 'PRECIPITABLE WATER KG/M2 P WAT '/ DATA NPARM(055)(01:60) / / 'VAPOR PRESSURE PA VAPP '/ DATA NPARM(056)(01:60) / / 'SATURATION DEFICIT PA SAT D '/ DATA NPARM(057)(01:60) / / 'EVAPORATION KG/M2 EVP '/ DATA NPARM(058)(01:60) / / 'CLOUD ICE KG/M2 C ICE '/ DATA NPARM(059)(01:60) / / 'PRECIPITATION RATE KG/M2/S PRATE '/ DATA NPARM(060)(01:60) / / 'THUNDERSTORM PROBABILITY % TSTM '/ DATA NPARM(061)(01:60) / / 'TOTAL PRECIPITATION KG/M2 A PCP '/ DATA NPARM(062)(01:60) / / 'LARGE SCALE PRECIPITATION (NON-CONV.) KG/M2 NCPCP '/ DATA NPARM(063)(01:60) / / 'CONVECTIVE PRECIPITATION KG/M2 ACPCP '/ DATA NPARM(064)(01:60) / / 'SNOWFALL RATE WATER EQUIVALENT KG/M2/S SRWEQ '/ DATA NPARM(065)(01:60) / / 'WATER EQUIV. OF ACCUM. SNOW DEPTH KG/M2 WEASD '/ DATA NPARM(066)(01:60) / / 'SNOW DEPTH M SNO D '/ DATA NPARM(067)(01:60) / / 'MIXED LAYER DEPTH M MIXHT '/ DATA NPARM(068)(01:60) / / 'TRANSIENT THERMOCLINE DEPTH M TTHDP '/ DATA NPARM(069)(01:60) / / 'MAIN THERMOCLINE DEPTH M MTHD '/ DATA NPARM(070)(01:60) / / 'MAIN THERMOCLINE ANOMALY M MTH A '/ DATA NPARM(071)(01:60) / / 'TOTAL CLOUD COVER % T CDC '/ DATA NPARM(072)(01:60) / / 'CONVECTIVE CLOUD COVER % CDCON '/ DATA NPARM(073)(01:60) / / 'LOW CLOUD COVER % L CDC '/ DATA NPARM(074)(01:60) / / 'MEDIUM CLOUD COVER % M CDC '/ DATA NPARM(075)(01:60) / / 'HIGH CLOUD COVER % H CDC '/ DATA NPARM(076)(01:60) / / 'CLOUD WATER KG/M2 C WAT '/ DATA NPARM(077)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(078)(01:60) / / 'CONVECTIVE SNOW KG/M2 SNO C '/ DATA NPARM(079)(01:60) / / 'LARGE SCALE SNOW KG/M2 SNO L '/ DATA NPARM(080)(01:60) / / 'WATER TEMPERATURE K WTMP '/ DATA NPARM(081)(01:60) / / 'LAND-SEA MASK(LAND=1;SEA=0) (SEE NOTE) FRACTION LAND '/ DATA NPARM(082)(01:60) / / 'DEVIATION OF SEA LEVEL FROM MEAN M DSL M '/ DATA NPARM(083)(01:60) / / 'SURFACE ROUGHNESS M SFC R '/ DATA NPARM(084)(01:60) / / 'ALBEDO % ALBDO '/ DATA NPARM(085)(01:60) / / 'SOIL TEMPERATURE K TSOIL '/ DATA NPARM(086)(01:60) / / 'SOIL MOISTURE CONTENT KG/M2 SOIL M '/ DATA NPARM(087)(01:60) / / 'VEGETATION % VEG '/ DATA NPARM(088)(01:60) / / 'SALINITY KG/KG SALTY '/ DATA NPARM(089)(01:60) / / 'DENSITY KG/M3 DEN '/ DATA NPARM(090)(01:60) / / 'WATER RUNOFF KG/M2 WATR '/ DATA NPARM(091)(01:60) / / 'ICE CONC. (ICE=1;NO ICE=0) (SEE NOTE) FRACTION ICE C '/ DATA NPARM(092)(01:60) / / 'ICE THICKNESS M ICETK '/ DATA NPARM(093)(01:60) / / 'DIRECTION OF ICE DRIFT DEG. TRUE DICED '/ DATA NPARM(094)(01:60) / / 'SPEED OF ICE DRIFT M/S SICED '/ DATA NPARM(095)(01:60) / / 'U-COMPONENT OF ICE DRIFT M/S U ICE '/ DATA NPARM(096)(01:60) / / 'V-COMPONENT OF ICE DRIFT M/S V ICE '/ DATA NPARM(097)(01:60) / / 'ICE GROWTH RATE M/S ICE G '/ DATA NPARM(098)(01:60) / / 'ICE DIVERGENCE /S ICE D '/ DATA NPARM(099)(01:60) / / 'SNOW MELT KG/M2 SNO M '/ DATA NPARM(100)(01:60) / / 'SIGNIF HT OF COMBINED WIND WAVES&SWELL M HTSGW '/ DATA NPARM(101)(01:60) / / 'DIRECTION OF WIND WAVES (FROM WHICH) DEG TRUE WVDIR '/ DATA NPARM(102)(01:60) / / 'SIGNIFICANT HEIGHT OF WIND WAVES M WVHGT '/ DATA NPARM(103)(01:60) / / 'MEAN PERIOD OF WIND WAVES S WVPER '/ DATA NPARM(104)(01:60) / / 'DIRECTION OF SWELL WAVES DEG TRUE SWDIR '/ DATA NPARM(105)(01:60) / / 'SIGNIFICANT HEIGHT OF SWELL WAVES M SWELL '/ DATA NPARM(106)(01:60) / / 'MEAN PERIOD OF SWELL WAVES S SWPER '/ DATA NPARM(107)(01:60) / / 'PRIMARY WAVE DIRECTION DEG TRUE DIRPW '/ DATA NPARM(108)(01:60) / / 'PRIMARY WAVE MEAN PERIOD S PERPW '/ DATA NPARM(109)(01:60) / / 'SECONDARY WAVE DIRECTION DEG TRUE DIRSW '/ DATA NPARM(110)(01:60) / / 'SECONDARY WAVE MEAN PERIOD S PERSW '/ DATA NPARM(111)(01:60) / / 'NET SHORT-WAVE RADIATION (SURFACE) W/M2 NSWRS '/ DATA NPARM(112)(01:60) / / 'NET LONG WAVE RADIATION (SURFACE) W/M2 NLWRS '/ DATA NPARM(113)(01:60) / / 'NET SHORT-WAVE RADIATION (TOP OF ATMOS) W/M2 NSWRT '/ DATA NPARM(114)(01:60) / / 'NET LONG WAVE RADIATION (TOP OF ATMOS) W/M2 NLWRT '/ DATA NPARM(115)(01:60) / / 'LONG WAVE RADIATION W/M2 LWAVR '/ DATA NPARM(116)(01:60) / / 'SHORT WAVE RADIATION W/M2 SWAVR '/ DATA NPARM(117)(01:60) / / 'GLOBAL RADIATION W/M2 G RAD '/ DATA NPARM(118)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(119)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(120)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(121)(01:60) / / 'LATENT HEAT NET FLUX W/M2 LHTFL '/ DATA NPARM(122)(01:60) / / 'SENSIBLE HEAT NET FLUX W/M2 SHTFL '/ DATA NPARM(123)(01:60) / / 'BOUNDARY LAYER DISSIPATION W/M2 BLYDP '/ DATA NPARM(124)(01:60) / / 'MOMENTUM FLUX, U COMPONENT N/M2 U FLX '/ DATA NPARM(125)(01:60) / / 'MOMENTUM FLUX, V COMPONENT N/M2 V FLX '/ DATA NPARM(126)(01:60) / / 'WIND MIXING ENERGY J WMIXE '/ DATA NPARM(127)(01:60) / / 'IMAGE DATA IMG D '/ C C 128 - 254 RESERVED FOR USE BY ORIGINATING CENTER C C NWS/NMC USAGE AS FOLLOWS... C DATA NPARM(128)(01:60) / / 'MEAN SEA LEVEL PRESSURE (STD ATM RED) PA MSLSA '/ DATA NPARM(129)(01:60) / / 'MEAN SEA LEVEL PRESSURE (MAPS SYS RED) PA MSLMA '/ DATA NPARM(130)(01:60) / / 'MEAN SEA LEVEL PRESSURE (ETA RED) PA MSLET '/ DATA NPARM(131)(01:60) / / 'SURFACE LIFTED INDEX K LFT X '/ DATA NPARM(132)(01:60) / / 'BEST (4 LAYER) LIFTED INDEX K 4LFTX '/ DATA NPARM(133)(01:60) / / 'K INDEX K K X '/ DATA NPARM(134)(01:60) / / 'SWEAT INDEX K S X '/ DATA NPARM(135)(01:60) / / 'HORIZONTAL MOISTURE DIVERGENCE KG/KG/S MCONV '/ DATA NPARM(136)(01:60) / / 'VERTICAL SPEED SHEAR 1/S VW SH '/ DATA NPARM(137)(01:60) / / '3-HR PRESSURE TENDENCY (STD ATM RED) PA/S TSLSA '/ DATA NPARM(138)(01:60) / / 'BRUNT-VAISALA FREQUENCY (SQUARED) 1/S2 BVF 2 '/ DATA NPARM(139)(01:60) / / 'POTENTIAL VORTICITY (DENSITY WEIGHTED) 1/S/M PV MW '/ DATA NPARM(140)(01:60) / / 'CATEGORICAL RAIN (YES=1; NO=0) NON-DIM CRAIN '/ DATA NPARM(141)(01:60) / / 'CATEGORICAL FREEZING RAIN (YES=1; NO=0) NON-DIM CFRZRN '/ DATA NPARM(142)(01:60) / / 'CATEGORICAL ICE PELLETS (YES=1; NO=0) NON-DIM CICEPL '/ DATA NPARM(143)(01:60) / / 'CATEGORICAL SNOW (YES=1; NO=0) NON-DIM CSNOW '/ DATA NPARM(144)(01:60) / / 'SOIL W ???? ----- SOILW '/ DATA NPARM(145)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(146)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(147)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(148)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(149)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(150)(01:60) / / 'COVAR. BETWN MERID & ZONAL WIND COMP M2/S2 COVMZ '/ DATA NPARM(151)(01:60) / / 'COVAR. BETWN TEMP & ZONAL WIND COMP K*M/S COVTZ '/ DATA NPARM(152)(01:60) / / 'COVAR. BETWN TEMP & MERID WIND COMP K*M/S COVTM '/ DATA NPARM(153)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(154)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(155)(01:60) / / 'GROUND HEAT FLUX W/M2 GFLUX '/ DATA NPARM(156)(01:60) / / 'CONVECTIVE INHIBITION J/KG CIN '/ DATA NPARM(157)(01:60) / / 'CONVECTIVE AVAILABLE POTENTIAL ENERGY J/KG CAPE '/ DATA NPARM(158)(01:60) / / 'TURBULENT KINETIC ENERGY J/KG TKE '/ DATA NPARM(159)(01:60) / / 'COND PRESS OF PARCEL LIFTED FROM IND SFC PA CONDP '/ DATA NPARM(160)(01:60) / / 'CLEAR SKY UPWARD SOLAR FLUX W/M2 CSUSF '/ DATA NPARM(161)(01:60) / / 'CLEAR SKY DOWNWARD SOLAR FLUX W/M2 CSDSF '/ DATA NPARM(162)(01:60) / / 'CLEAR SKY UPWARD LONG WAVE FLUX W/M2 CSULF '/ DATA NPARM(163)(01:60) / / 'CLEAR SKY DOWNWARD LONG WAVE FLUX W/M2 CSDLF '/ DATA NPARM(164)(01:60) / / 'CLOUD FORCING NET SOLAR FLUX W/M2 CFNSF '/ DATA NPARM(165)(01:60) / / 'CLOUD FORCING NET LONG WAVE FLUX W/M2 CFNLF '/ DATA NPARM(166)(01:60) / / 'VISIBLE BEAM DOWNWARD SOLAR FLUX W/M2 VBDSF '/ DATA NPARM(167)(01:60) / / 'VISIBLE DIFFUSE DOWNWARD SOLAR FLUX W/M2 VDDSF '/ DATA NPARM(168)(01:60) / / 'NEAR IR BEAM DOWNWARD SOLAR FLUX W/M2 NBDSF '/ DATA NPARM(169)(01:60) / / 'NEAR IR DIFFUSE DOWNWARD SOLAR FLUX W/M2 NDDSF '/ DATA NPARM(170)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(171)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(172)(01:60) / / 'MOMENTUM FLUX N/M2 M FLX '/ DATA NPARM(173)(01:60) / / 'MASS POINT MODEL SURFACE NON-DIM LMH '/ DATA NPARM(174)(01:60) / / 'VELOCITY POINT MODEL SURFACE NON-DIM LMV '/ DATA NPARM(175)(01:60) / / 'MODEL LAYER NUMBER (FROM BOTTOM UP) NON-DIM MLYNO '/ DATA NPARM(176)(01:60) / / 'LATITUDE (-90 TO +90) DEG NLAT '/ DATA NPARM(177)(01:60) / / 'EAST LONGITUDE (0-360) DEG ELON '/ DATA NPARM(178)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(179)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(180)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(181)(01:60) / / 'X-GRADIENT OF LOG PRESSURE 1/M LPS X '/ DATA NPARM(182)(01:60) / / 'Y-GRADIENT OF LOG PRESSURE 1/M LPS Y '/ DATA NPARM(183)(01:60) / / 'X-GRADIENT OF HEIGHT M/M HGT X '/ DATA NPARM(184)(01:60) / / 'Y-GRADIENT OF HEIGHT M/M HGT Y '/ DATA NPARM(185)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(186)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(187)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(188)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(189)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(190)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(191)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(192)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(193)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(194)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(195)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(196)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(197)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(198)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(199)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(200)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(201)(01:60) / / 'ICE-FREE WATER SURFACE % ICWAT '/ DATA NPARM(202)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(203)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(204)(01:60) / / 'DOWNWARD SHORT WAVE RAD. FLUX W/M2 DSWRF '/ DATA NPARM(205)(01:60) / / 'DOWNWARD LONG WAVE RAD. FLUX W/M2 DLWRF '/ DATA NPARM(206)(01:60) / / 'ULTRA VIOLET POTENTIAL INDEX W/M2 UVPI '/ DATA NPARM(207)(01:60) / / 'MOISTURE AVAILABILITY % MSTAV '/ DATA NPARM(208)(01:60) / / 'EXCHANGE COEFFICIENT (KG/M3)(M/S) SFEXC '/ DATA NPARM(209)(01:60) / / 'NO. OF MIXED LAYERS NEXT TO SURFACE INTEGER MIXLY '/ DATA NPARM(210)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(211)(01:60) / / 'UPWARD SHORT WAVE RAD. FLUX W/M2 USWRF '/ DATA NPARM(212)(01:60) / / 'UPWARD LONG WAVE RAD. FLUX W/M2 ULWRF '/ DATA NPARM(213)(01:60) / / 'AMOUNT OF NON-CONVECTIVE CLOUD % CDLYR '/ DATA NPARM(214)(01:60) / / 'CONVECTIVE PRECIPITATION RATE KG/M2/S CPRAT '/ DATA NPARM(215)(01:60) / / 'TEMPERATURE TENDENCY BY ALL PHYSICS K/S TTDIA '/ DATA NPARM(216)(01:60) / / 'TEMPERATURE TENDENCY BY ALL RADIATION K/S TTRAD '/ DATA NPARM(217)(01:60) / / 'TEMPERATURE TENDENCY BY NON-RADIATION K/S TTPHY '/ DATA NPARM(218)(01:60) / / 'PRECIP.INDEX(0.0-1.00)(SEE NOTE) FRACTION PREIX '/ DATA NPARM(219)(01:60) / / 'STD. DEV. OF IR T OVER 1X1 DEG AREA K TSD1D '/ DATA NPARM(220)(01:60) / / 'NATURAL LOG OF SURFACE PRESSURE LN(KPA) NLGSP '/ DATA NPARM(221)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(222)(01:60) / / '5-WAVE GEOPOTENTIAL HEIGHT GPM 5WAVH '/ DATA NPARM(223)(01:60) / / 'PLANT CANOPY SURFACE WATER KG/M2 C WAT '/ DATA NPARM(224)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(225)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(226)(01:60) / / 'BLACKADARS MIXING LENGTH SCALE M BMIXL '/ DATA NPARM(227)(01:60) / / 'ASYMPTOTIC MIXING LENGTH SCALE M AMIXL '/ DATA NPARM(228)(01:60) / / 'POTENTIAL EVAPORATION KG/M2 PEVAP '/ DATA NPARM(229)(01:60) / / 'SNOW PHASE-CHANGE HEAT FLUX W/M2 SNOHF '/ DATA NPARM(230)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(231)(01:60) / / 'CONVECTIVE CLOUD MAS FLUX PA/S MFLUX '/ DATA NPARM(232)(01:60) / / 'DOWNWARD TOTAL RADIATION FLUX W/M2 DTRF '/ DATA NPARM(233)(01:60) / / 'UPWARD TOTAL RADIATION FLUX W/M2 UTRF '/ DATA NPARM(234)(01:60) / / 'BASEFLOW-GROUNDWATER RUNOFF KG/M2 BGRUN '/ DATA NPARM(235)(01:60) / / 'STORM SURFACE RUNOFF KG/M2 SSRUN '/ DATA NPARM(236)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(237)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(238)(01:60) / / 'SNOW COVER PERCENT SNO C '/ DATA NPARM(239)(01:60) / / 'SNOW TEMPERATURE K SNO T '/ DATA NPARM(240)(01:60) / / 'RESERVED ----- ----- '/ DATA NPARM(241)(01:60) / / 'LARGE SCALE CONDENSAT. HEAT RATE K/S LRGHR '/ DATA NPARM(242)(01:60) / / 'DEEP CONVECTIVE HEATING RATE K/S CNVHR '/ DATA NPARM(243)(01:60) / / 'DEEP CONVECTIVE MOISTENING RATE KG/KG/S CNVMR '/ DATA NPARM(244)(01:60) / / 'SHALLOW CONVECTIVE HEATING RATE K/S SHAHR '/ DATA NPARM(245)(01:60) / / 'SHALLOW CONVECTIVE MOISTENING RATE KG/KG/S SHAMR '/ DATA NPARM(246)(01:60) / / 'VERTICAL DIFFUSION HEATING RATE K/S VDFHR '/ DATA NPARM(247)(01:60) / / 'VERTICAL DIFFUSION ZONAL ACCELERATION M/S2 VDFUA '/ DATA NPARM(248)(01:60) / / 'VERTICAL DIFFUSION MERIDIONAL ACCEL M/S2 VDFVA '/ DATA NPARM(249)(01:60) / / 'VERTICAL DIFFUSION MOISTENING RATE KG/KG/S VDFMR '/ DATA NPARM(250)(01:60) / / 'SOLAR RADIATIVE HEATING RATE K/S SWHR '/ DATA NPARM(251)(01:60) / / 'LONG WAVE RADIATIVE HEATING RATE K/S LWHR '/ DATA NPARM(252)(01:60) / / 'DRAG COEFFICIENT NON-DIM CD '/ DATA NPARM(253)(01:60) / / 'FRICTION VELOCITY M/S FRICV '/ DATA NPARM(254)(01:60) / / 'RICHARDSON NUMBER NON-DIM. RI '/ DATA NPARM(255)(01:60) / / 'MISSING '/ DATA NPARM(256)(01:60) / / 'RESERVED ----- ----- '/ C SAVE C CPARM(01:32) = ' ' CPARM(33:64) = ' ' C IDO = 1 IF (IDO.EQ.1) THEN CPARM(01:60) = NPARM(IPARM)(01:60) ENDIF RETURN END SUBROUTINE NLEVLM (ILEVLAY,ILEVEL,CLEVL,JDO) C C MAP THE GRIB1 LEVEL/LAYER INDICATOR AND VALUE TO A VERBAL STRING C C *** SOME OF OUR INTERPRATATIONS OF THE TIME RANGE INDICATOR MAY BE IN DOUBT C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER CLEVL*(*) CHARACTER*56 NLEVL(256) C DATA NLEVL(001)(01:51) / / 'RESERVED '/ DATA NLEVL(002)(01:51) / / 'SURFACE, EARTH OR SEA '/ DATA NLEVL(003)(01:51) / / 'CLOUD BASE LEVEL '/ DATA NLEVL(004)(01:51) / / 'CLOUD TOP LEVEL '/ DATA NLEVL(005)(01:51) / / '0 DEG (C) ISOTHERM LEVEL '/ DATA NLEVL(006)(01:51) / / 'ADIAB. CONDENSATION LEVEL (PARCEL LIFTED FROM SFC) '/ DATA NLEVL(007)(01:51) / / 'MAXIMUM WIND SPEED LEVEL '/ DATA NLEVL(008)(01:51) / / 'TROPOPAUSE LEVEL '/ DATA NLEVL(009)(01:51) / / 'NOMINAL TOP OF ATMOSPHERE '/ DATA NLEVL(010)(01:51) / / 'SEA BOTTOM '/ C DATA NLEVL(101)(01:51) / / 'HPA ISOBARIC LEVEL '/ DATA NLEVL(102)(01:51) / / 'KPA LAYER BETWEEN TWO ISOBARIC LEVELS '/ DATA NLEVL(103)(01:51) / / 'MEAN SEA LEVEL '/ DATA NLEVL(104)(01:51) / / 'M FIXED HEIGHT LEVEL ABOVE MEAN SEA LEVEL (MSL) '/ DATA NLEVL(105)(01:51) / / 'HM LAYER BETWEEN TWO HEIGHT LEVELS ABOVE MSL '/ DATA NLEVL(106)(01:51) / / 'M FIXED HEIGHT ABOVE GROUND (AGL) '/ DATA NLEVL(107)(01:51) / / 'HM LAYER BETWEEN TWO HEIGHT LEVELS ABOVE AGL '/ DATA NLEVL(108)(01:51) / / '1/10000 SIGMA LEVEL '/ DATA NLEVL(109)(01:51) / / '1/100 LAYER BETWEEN TWO SIGMA LEVELS '/ DATA NLEVL(110)(01:51) / / 'LEV.NO HYBRID LEVEL '/ DATA NLEVL(111)(01:51) / / 'LEV.NO LAYER BETWEEN HYBRID LEVELS '/ DATA NLEVL(112)(01:51) / / 'CM DEPTH BELOW LAND SURFACE '/ DATA NLEVL(113)(01:51) / / 'CM LAYER BETWEEN TWO DEPTHS BELOW LAND SURFACE '/ DATA NLEVL(114)(01:51) / / 'K ISENTROPIC (THETA) LEVEL '/ DATA NLEVL(115)(01:51) / / '475K-K LAYER BETWEEN TWO ISENTROPIC LEVELS '/ DATA NLEVL(116)(01:51) / / 'HPA LEVEL AT SPECIFIED PRESSURE DIFFERENCE AGL '/ DATA NLEVL(117)(01:51) / / 'HPA LAYER BETWN 2 LEVELS AT SPEC. PRESS. DIFF. AGL'/ DATA NLEVL(122)(01:51) / / '1100HPA-HPA LAYER BETWN 2 ISOBARIC SURFACES '/ DATA NLEVL(126)(01:51) / / 'CM HEIGHT LEVAL ABOVE GROUND (AGL) '/ DATA NLEVL(129)(01:51) / / '1/1000 1.1-SIGMA LAYER BETWEEN TWO SIGMA LEVELS '/ DATA NLEVL(142)(01:51) / / 'KPA & HPA:1100-HPA LAYER BETWN TWO ISOBARIC SFCS '/ DATA NLEVL(161)(01:51) / / 'M DEPTH BELOW SEA LEVEL '/ DATA NLEVL(201)(01:51) / / 'ENTIRE ATMOSPHERE AS A SINGLE LAYER '/ DATA NLEVL(202)(01:51) / / 'ENTIRE OCEAN AS A SINGLE LAYER '/ C DATA NLEVL(213)(01:51) / / 'LOW CLOUD BOTTOM LEVEL '/ DATA NLEVL(214)(01:51) / / 'LOW CLOUD TOP LEVEL '/ DATA NLEVL(215)(01:51) / / 'LOW CLOUD LAYER '/ DATA NLEVL(223)(01:51) / / 'MIDDLE CLOUD BOTTOM LEVEL '/ DATA NLEVL(224)(01:51) / / 'MIDDLE CLOUD TOP LEVEL '/ DATA NLEVL(225)(01:51) / / 'MIDDLE CLOUD LAYER '/ DATA NLEVL(233)(01:51) / / 'HIGH CLOUD BOTTOM LEVEL '/ DATA NLEVL(234)(01:51) / / 'HIGH CLOUD TOP LEVEL '/ DATA NLEVL(235)(01:51) / / 'HIGH CLOUD LAYER '/ C DIMENSION IDO(256) C 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20 DATA IDO / 1 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 6 2, 1, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 0, 0, 0, 0, 7 2, 0, 0, 0, 1, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 1 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 0, 0, 0, 0, 0, 0, 2 0, 1, 1, 2, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ C SAVE C CLEVL(01:32) = ' ' CLEVL(33:64) = ' ' C IF (ILEVLAY.GT.0) THEN JDO = IDO(ILEVLAY) ELSE JDO = 0 ENDIF IF (JDO.EQ.0) THEN ILEV1 = 0 ILEV2 = 0 ENDIF IF (JDO.EQ.1) THEN ILEV1 = ILEVEL ILEV2 = 0 ENDIF IF (JDO.EQ.2) THEN CALL GBYTE (ILEVEL,ILEV1,48,8) CALL GBYTE (ILEVEL,ILEV2,56,8) ENDIF WRITE (CLEVL(01:12),9006) ILEV1, ILEV2 9006 FORMAT (2I6) IF (JDO.NE.0) THEN CLEVL(14:64) = NLEVL(ILEVLAY+1)(01:51) ENDIF RETURN END SUBROUTINE TIMRNM (CTIMRN,CTIMRN1) C C MAP THE GRIB1 TIME RANGE INDICATOR TO A VERBAL STRING C C *** SOME OF OUR INTERPRATATIONS OF THE TIME RANGE INDICATOR MAY BE IN DOUBT C C WRITTEN BY G. WALTERS - DSS / 1997 JUNE C C DOING THIS HERE INSTEAD OF IN RGRIB1 OR THE MAIN PROGRAM C TO REDUCE CLUTTER C CHARACTER TEMP*8, GRIB*4, FOUR7S*4 C COMMON / GRIBIS / IBLK, IBFCTR, IGIB, IOFF, GRIB, FOUR7S, IED, 2 LENMESS C COMMON / GRIBPDS / LENPDS, IPTV, ICTR, ICGEN, 2 IGRID, IIDIM, IJDIM, IPOLE, IGDS, IBMS, IPARM, 3 ILEVLAY, ILEVEL, ILEV1, ILEV2, IDO, IYR, IMO, IDY, IHR, IMI, 4 IFTUN, IP1, IP2, ITIMRAN, INUM, INUMMSG, ICENT, ISUBCTR, IDECF, 5 IRESRV1(12), IRESRV2(30), IFCST C CHARACTER CTIMRN*(*), CTIMRN1*(*) C CHARACTER*4 FUNITS(10) DATA FUNITS / 'MINS', 'HRS ', 'DAYS', 'MONS', 'YRS ', / 'DECS', '30YR', 'CENT', 'SECS', ' '/ C CHARACTER*8 FORANAL C SAVE C C ITIMRAN JTIMRAN C 0 3 C 0 2 C 1 1 C 2 4 C 3 5 C 4 6 C 5 7 C 6-9 RESERVED C 10 8 C 11-50 RESERVED C 51 9 C 52-112 RESERVED C 113 10 C 114 11 C 115 12 C 116 13 C 117 14 C 118 15 C 119-122 RESERVED C 123 16 C 124 17 C 125-254 RESERVED C JFTUN = 2 IF (IFTUN.GE.0.AND.IFTUN.LE.7) THEN JFTUN = IFTUN + 1 ENDIF IF (IFTUN.EQ.254) JFTUN = 9 JTIMRAN = 0 IF (ITIMRAN.EQ.1.AND.IP1.EQ.0) JTIMRAN = 1 IF (ITIMRAN.EQ.0.AND.IP1.EQ.0) JTIMRAN = 2 IF (ITIMRAN.EQ.0.AND.IP1.GT.0) JTIMRAN = 3 IF (ITIMRAN.GE.2.AND.ITIMRAN.LE.5) JTIMRAN = ITIMRAN + 2 IF (ITIMRAN.EQ. 10) JTIMRAN = 8 IF (ITIMRAN.EQ. 51) JTIMRAN = 9 IF (ITIMRAN.EQ.113) JTIMRAN = 10 IF (ITIMRAN.EQ.114) JTIMRAN = 11 IF (ITIMRAN.EQ.115) JTIMRAN = 12 IF (ITIMRAN.EQ.116) JTIMRAN = 13 IF (ITIMRAN.EQ.117) JTIMRAN = 14 IF (ITIMRAN.EQ.118) JTIMRAN = 15 IF (ITIMRAN.EQ.123) JTIMRAN = 16 IF (ITIMRAN.EQ.124) JTIMRAN = 17 IF (JTIMRAN.GE.1.OR.JTIMRAN.LE.17) THEN IFCST = 0 ELSE IFCST = -9 ENDIF CTIMRN1(01:24) = ' ' CTIMRN1(25:48) = ' ' CTIMRN1(49:72) = ' ' CTIMRN1(73:88) = ' ' GOTO ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17) JTIMRAN CTIMRN(01:08) = 'UNKNOWN ' RETURN 1 CONTINUE CTIMRN(01:08) = 'ANALYSIS' CTIMRN1(01:24) = 'INITIALIZED, VALID AT RE' CTIMRN1(25:30) = 'F.TIME' RETURN 2 CONTINUE CTIMRN(01:08) = 'ANALYSIS' CTIMRN1(01:24) = 'UNINITIALIZED, VALID AT ' CTIMRN1(25:32) = 'REF.TIME' RETURN 3 CONTINUE CTIMRN(01:08) = 'FORECAST' CTIMRN1(01:18) = 'VALID AT REF.TIME+' IFCST = IP1 WRITE (CTIMRN1(19:23),9005) IP1 9005 FORMAT (I5) CTIMRN1(24:24) = ' ' CTIMRN1(25:28) = FUNITS(JFTUN)(1:4) RETURN 4 CONTINUE CTIMRN(01:08) = 'ANALYSIS' CTIMRN1(01:15) = 'VALID REF.TIME+' WRITE (CTIMRN1(16:19),9004) IP1 9004 FORMAT (I4) CTIMRN1(20:24) = ' AND ' WRITE (CTIMRN1(25:28),9004) IP2 CTIMRN1(29:29) = ' ' CTIMRN1(30:33) = FUNITS(JFTUN)(1:4) RETURN 5 CONTINUE CTIMRN(01:08) = 'AVERAGE ' CTIMRN1(01:13) = 'FOR REF.TIME+' WRITE (CTIMRN1(14:17),9004) IP1 CTIMRN1(18:18) = ' ' CTIMRN1(19:22) = FUNITS(JFTUN)(1:4) CTIMRN1(23:25) = ' TO' WRITE (CTIMRN1(26:29),9004) IP2 CTIMRN1(30:30) = ' ' CTIMRN1(31:34) = FUNITS(JFTUN)(1:4) RETURN 6 CONTINUE CTIMRN(01:08) = 'ACCUMULA' CTIMRN1(01:08) = 'TION FOR' IPP = IP2 - IP1 WRITE (CTIMRN1(09:12),9004) IPP CTIMRN1(13:13) = ' ' CTIMRN1(14:17) = FUNITS(JFTUN)(1:4) CTIMRN1(18:36) = ' VALID AT REF.TIME+' WRITE (CTIMRN1(37:40),9004) IP2 CTIMRN1(41:41) = ' ' CTIMRN1(44:47) = FUNITS(JFTUN)(1:4) RETURN 7 CONTINUE CTIMRN(01:08) = 'DIFFEREN' CTIMRN1(01:08) = 'CE FOR ' IPP = IP2 - IP1 WRITE (CTIMRN1(09:12),9004) IPP CTIMRN1(13:13) = ' ' CTIMRN1(14:17) = FUNITS(JFTUN)(1:4) CTIMRN1(18:36) = ' VALID AT REF.TIME+' WRITE (CTIMRN1(37:40),9004) IP2 CTIMRN1(41:41) = ' ' CTIMRN1(44:47) = FUNITS(JFTUN)(1:4) RETURN 8 CONTINUE IPP = IP1*256 + IP2 IF (IPP.EQ.0) THEN CTIMRN(01:08) = 'ANALYSIS' IFCST = 0 ELSE CTIMRN(01:08) = 'FORECAST' IFCST = IPP ENDIF CTIMRN1(01:18) = 'VALID AT REF.TIME+' WRITE (CTIMRN1(19:23),9005) IPP CTIMRN1(24:24) = ' ' CTIMRN1(25:28) = FUNITS(JFTUN)(1:4) RETURN 9 CONTINUE IF (IP1.EQ.0) THEN CTIMRN(01:08) = 'CLIMATE ' CTIMRN1(01:10) = 'MEAN, FOR ' WRITE (CTIMRN1(11:14),9004) IP2 CTIMRN1(15:15) = ' ' CTIMRN1(16:19) = FUNITS(JFTUN)(1:4) CTIMRN1(20:29) = ' BASED ON ' WRITE (CTIMRN1(30:34),9005) INUM CTIMRN1(35:48) = ' YEARS BEGINNI' CTIMRN1(49:62) = 'NG AT REF.TIME' ENDIF IF (IP1.EQ.1) THEN CTIMRN(01:08) = 'CLIMATE ' CTIMRN1(01:10) = 'MEAN, FOR ' WRITE (CTIMRN1(11:14),9004) IP2 CTIMRN1(15:15) = ' ' CTIMRN1(16:19) = FUNITS(JFTUN)(1:4) CTIMRN1(20:29) = ' BASED ON ' WRITE (CTIMRN1(30:34),9005) INUM CTIMRN1(35:48) = ' YEARS, CENTER' CTIMRN1(49:62) = 'ED AT REF.TIME' C CTIMRN1(35:48) = ' YEARS, VALID ' C CTIMRN1(49:59) = 'AT REF.TIME' ENDIF RETURN 10 CONTINUE CTIMRN(01:08) = 'AVERAGE ' CTIMRN1(01:03) = 'OF ' WRITE (CTIMRN1(04:08),9005) INUM IF (IP1.EQ.0) THEN FORANAL = 'ANALYSES' ELSE FORANAL = 'FORECAST' ENDIF CTIMRN1(09:09) = ' ' CTIMRN1(10:17) = FORANAL(1:8) CTIMRN1(18:34) = ' S, AT PERIODS OF' WRITE (CTIMRN1(35:38),9004) IP1 CTIMRN1(39:39) = ' ' CTIMRN1(40:43) = FUNITS(JFTUN)(1:4) CTIMRN1(44:70) = ' FOR REF.TIME INTERVALS OF ' WRITE (CTIMRN1(71:74),9004) IP1 CTIMRN1(75:75) = ' ' CTIMRN1(76:79) = FUNITS(JFTUN)(1:4) RETURN 11 CONTINUE CTIMRN(01:08) = 'ACCUMULA' CTIMRN1(01:10) = 'LATION OF ' WRITE (CTIMRN1(11:15),9005) INUM IF (IP1.EQ.0) THEN FORANAL = 'ANALYSES' ELSE FORANAL = 'FORECAST' ENDIF CTIMRN1(16:16) = ' ' CTIMRN1(17:24) = FORANAL(1:8) CTIMRN1(25:41) = ' S, AT PERIODS OF' WRITE (CTIMRN1(42:45),9004) IP1 CTIMRN1(46:46) = ' ' CTIMRN1(47:50) = FUNITS(JFTUN)(1:4) CTIMRN1(51:77) = ' FOR REF.TIME INTERVALS OF ' WRITE (CTIMRN1(78:81),9004) IP1 CTIMRN1(82:82) = ' ' CTIMRN1(83:86) = FUNITS(JFTUN)(1:4) RETURN 12 CONTINUE CTIMRN(01:08) = 'AVERAGE ' CTIMRN1(01:03) = ' OF ' WRITE (CTIMRN1(04:08),9005) INUM CTIMRN1(09:37) = ' FORECASTS WITH SAME REF.TIME' CTIMRN1(38:49) = ' FOR PERIOD ' WRITE (CTIMRN1(50:53),9004) IP1 CTIMRN1(54:54) = ' ' CTIMRN1(55:58) = FUNITS(JFTUN)(1:4) CTIMRN1(59:67) = ' THEN AT ' WRITE (CTIMRN1(68:71),9004) IP1 CTIMRN1(72:72) = ' ' CTIMRN1(73:76) = FUNITS(JFTUN)(1:4) CTIMRN1(77:86) = ' INTERVALS' RETURN 13 CONTINUE CTIMRN(01:08) = 'ACCUMULA' CTIMRN1(01:08) = 'TION OF ' WRITE (CTIMRN1(09:13),9005) INUM CTIMRN1(14:39) = ' FCSTS WITH SAME REF.TIME' CTIMRN1(40:51) = ' FOR PERIOD ' WRITE (CTIMRN1(52:55),9004) IP1 CTIMRN1(56:56) = ' ' CTIMRN1(57:60) = FUNITS(JFTUN)(1:4) CTIMRN1(61:69) = ' THEN AT ' WRITE (CTIMRN1(70:73),9004) IP1 CTIMRN1(74:74) = ' ' CTIMRN1(75:78) = FUNITS(JFTUN)(1:4) CTIMRN1(79:88) = ' INTERVALS' RETURN 14 CONTINUE CTIMRN(01:08) = 'AVERAGE ' CTIMRN1(01:03) = ' OF ' WRITE (CTIMRN1(04:08),9005) INUM CTIMRN1(09:27) = ' FORECASTS VALID AT' CTIMRN1(28:37) = ' REF.TIME+' WRITE (CTIMRN1(38:41),9004) IP1 CTIMRN1(42:42) = ' ' CTIMRN1(43:46) = FUNITS(JFTUN)(1:4) CTIMRN1(47:55) = ' MADE AT ' WRITE (CTIMRN1(56:59),9004) IP1 CTIMRN1(60:60) = ' ' CTIMRN1(61:64) = FUNITS(JFTUN)(1:4) CTIMRN1(65:74) = ' INTERVALS' RETURN 15 CONTINUE CTIMRN(01:08) = 'COVARIAN' CTIMRN1(01:06) = 'CE OF ' WRITE (CTIMRN1(07:11),9005) INUM CTIMRN1(12:30) = ' INIT. ANALYSES AT ' WRITE (CTIMRN1(31:34),9004) IP2 CTIMRN1(35:35) = ' ' CTIMRN1(36:40) = FUNITS(JFTUN)(1:4) CTIMRN1(41:64) = ' INTERVALS STARTING AT T' CTIMRN1(65:76) = 'HE REF.TIME' RETURN 16 CONTINUE CTIMRN(01:08) = 'AVERAGE ' CTIMRN1(01:03) = 'OF ' WRITE (CTIMRN1(04:08),9005) INUM CTIMRN1(09:35) = ' UNINITIALIZED ANALYSES AT ' CTIMRN1(36:44) = ' REF.TIM+' WRITE (CTIMRN1(45:48),9004) IP2 CTIMRN1(49:49) = ' ' CTIMRN1(50:53) = FUNITS(JFTUN)(1:4) CTIMRN1(54:64) = ' INTERVALS' RETURN 17 CONTINUE CTIMRN(01:08) = 'ACCUMULA' CTIMRN1(01:08) = 'TION OF ' WRITE (CTIMRN1(09:13),9005) INUM CTIMRN1(14:40) = ' UNINITIALIZED ANALYSES AT ' CTIMRN1(41:49) = ' REF.TIM+' WRITE (CTIMRN1(50:53),9004) IP2 CTIMRN1(54:54) = ' ' CTIMRN1(55:58) = FUNITS(JFTUN)(1:4) CTIMRN1(63:69) = ' INTERVALS' RETURN END