w3fp11.f

Go to the documentation of this file.

C> @file
C> @brief One-line GRIB titler from pds section.
C> @author Ralph Jones @date 1991-06-19
 
C> Converts GRIB formatted product definition section version
C> 1 to a one line readable title. GRIB section 0 is also tested to
C> verify that GRIB data is being deciphered.
C>
C> ### Program History Log:
C> Date | Programmer | Comments
C> -----|------------|---------
C> 1991-06-19 | Ralph Jones |  Initial
C> 1992-05-29 | Ralph Jones |  Add water temp to tables
C> 1993-01-19 | Ralph Jones |  Add montgomary stream function to tables. add code for surface value 113. add condensation pressure to tables
C> 1993-02-19 | Ralph Jones |  Add cape and tke (157 & 158) to tables
C> 1993-02-24 | Ralph Jones |  Add GRIB type pmsle (130) to tables
C> 1993-03-26 | Ralph Jones |  Add GRIB type sglyr (175) to tables
C> 1993-03-27 | Ralph Jones |  Changes for revised o.n.388 mar. 3,1993
C> 1993-03-29 | Ralph Jones |  Add save statement
C> 1993-04-16 | Ralph Jones |  Add GRIB type lat, lon (176,177) to tables
C> 1993-04-25 | Ralph Jones |  Add GRIB type 204, 205, 211, 212, 218
C> 1993-05-18 | Ralph Jones |  Add test for model 70
C> 1993-06-26 | Ralph Jones |  Add GRIB type 128, 129, take out test for MODEL 86.
C> 1993-08-07 | Ralph Jones |  Add GRIB type 156 (cin), 150 (cbmzw), 151 (cbtzw), 152 (cbtmw) to tables.
C> 1993-10-14 | Ralph Jones |  Change for o.n. 388 rev. oct. 8,1993
C> 1993-10-29 | Ralph Jones |  Change for 'l cdc' 'm cdc' 'h cdc'
C> 1993-10-14 | Ralph Jones |  Change for o.n. 388 rev. nov. 19,1993
C> 1994-02-05 | Ralph Jones |  Change for o.n. 388 rev. dec. 14,1993. add model number 86 and 87.
C> 1994-03-24 | Ralph Jones |  Add GRIB type 24 (toto3), 206 (uvpi)
C> 1994-06-04 | Ralph Jones |  Change uvpi to uvi
C> 1994-06-16 | Ralph Jones |  Add GRIB type 144,145,146,147,148,149 soilw,pevpr,cwork,u-gwd,v-gwd,pv to tables.
C> 1994-06-22 | Ralph Jones |  Add ncar (60) to centers
C> 1994-07-25 | Ralph Jones |  Correction for 71, 72, 213 (t cdc), (cdcon), (cdlyr)
C> 1994-10-27 | Ralph Jones |  Add GRIB type 191 (prob), 192 (probn), add test for model 90, 91, 92, 93, add sub center 2.
C> 1995-02-09 | Ralph Jones |  Correction for century for fnoc
C> 1995-04-11 | Ralph Jones |  Correction for lmh and lmv
C> 1995-06-20 | Ralph Jones |  Add GRIB type 189 (vstm), 190 (hlcy), 193 (pop), 194 (cpofp), 195 (cpozp), 196 (ustm), 197 (vstm) to tables.
C> 1995-08-07 | Ralph Jones |  Add GRIB type 153 (clwmr), 154 (o3mr), 221 (hpbl), 237 (o3tot).
C> 1995-09-07 | Ralph Jones |  Take out GRIB type 24 (toto3), change to GRIB type 10 (tozne). add level 117, potential vortiticity (pv) level, add eta
C>      ^     |     ^      |  Level 119, add 120 layer betwwen two eta levels. change name of level 107 to (sigl), change name of level 108 to (sigy).
C> 1995-09-26 | Ralph Jones |  Add level 204 (htfl) highest tropsphere freezing level.
C> 1995-10-19 | Ralph Jones |  Change some of the level abreviations.
C> 1995-12-13 | Ralph Jones |  Add 8 sub-centers to tables
C> 1996-03-04 | Ralph Jones |  Changes for o.n. 388 jan 2, 1996
C> 1996-03-22 | Ralph Jones |  Change scusf to csusf
C> 1996-10-01 | Mark Iredell |  Recognize forecast time units 1 to 12 and correct for year 2000
C> 1996-10-31 | Ralph Jones |  Change array and table for ics1 to 10.
C> 1996-10-01 | Mark Iredell |  Allow parameter table version up to 127
C> 1998-05-26 | Stephen Gilbert |  Added 17 new parameters ( GRIB table 2 ). added 6 new special levels for clouds. added subcenter 11 (tdl) under center 7 (ncep)
C> 1998-12-21 | Stephen Gilbert |  Replaced function ichar with mova2i.
C> 1901-01-05 | Boi Vuong |  Add level 247 (ehlt) equilibrium level
C> 1902-05-01 | Boi Vuong |  Changes for o.n. 388   mar 21, 2002
C> 1902-03-25 | Boi Vuong |  Add GRIB table version 129 and 130
C> 1903-07-02 | Stephen Gilbert |  Added 5 new params to table version 129
C> 1904-14-04 | Boi Vuong |  Add GRIB table version 131 and added 12 new parameter to table version 129
C> 1904-08-09 | Boi Vuong |  Add parameter (thflx) to table version 129
C> 1905-02-08 | Cooke |  Corrected entry for freezing rain, crfzr to cfrzr in the hhnam1 array
C> 1906-08-11 | Boi Vuong |  Add levels (235,236,237,238,240,245) and added new parameters to table version 129 and added
C>    ^       |     ^      |  One parameter 154 to table version 130 and added table version 128
C> 1907-04-05 | Boi Vuong |  Add parameters to table version 128, 129 and 130
C> 1907-05-15 | Boi Vuong |  Added time range indicator 51 and new table 140
C>
C> @param[in] IPDS0 GRIB section 0 read as character*8
C> @param[in] IPDS GRIB pds section read as character*28
C> @param[out] TITL Character*86 output print line
C> @param[out] IERR
C> 0 - Completed satisfactorily
C> 1 - GRIB section 0, can not find 'GRIB'
C> 2 - GRIB is not version 1
C> 3 - Length of pds section is less than 28
C> 4 - Could not match type indicator
C> 5 - Could not match type level
C> 6 - Could not interpret originator of code
C> 7 - Could not interpret sub center 7 originator of code
C> 8 - Could not interpret sub center 9 originator of code
C> 9 - Parameter table version not 1 or 2
C>
      SUBROUTINE w3fp11 (IPDS0, IPDS, TITL, IERR)
        INTEGER         CENTER(17)
        INTEGER         SCNTR1(16)
        INTEGER         SCNTR2(14)
        INTEGER         FCSTIM
        INTEGER         HH(252)
        INTEGER         HH1(105)
        INTEGER         HH2(105)
        INTEGER         HH3(42)
        INTEGER         HH128(72)
        INTEGER         HH129(98)
        INTEGER         HH130(112)
        INTEGER         HH131(241)
        INTEGER         HH140(112)
        INTEGER         HHH(73)
        INTEGER         IERR
        INTEGER         P1
        INTEGER         P2
        INTEGER         TIMERG
C
        CHARACTER * 6   HHNAM(252)
        CHARACTER * 6   HHNAM1(105)
        CHARACTER * 6   HHNAM2(105)
        CHARACTER * 6   HHNAM3(42)
        CHARACTER * 6   HHNAM128(72)
        CHARACTER * 6   HHNAM129(98)
        CHARACTER * 6   HHNAM130(112)
        CHARACTER * 6   HHNAM140(112)
        CHARACTER * 6   HHNAM131(241)
        CHARACTER * 4   HHHNAM(73)
        CHARACTER * (*) IPDS
        CHARACTER * 8   IPDS0
        CHARACTER * 28  IDPDS
        CHARACTER * 4   GRIB
        CHARACTER * 28  KNAM1(17)
        CHARACTER * 28  KNAM2(16)
        CHARACTER * 28  KNAM3(14)
        CHARACTER * 3   MONTH(12)
        CHARACTER * 4   TIMUN(12)
        CHARACTER * 2   TIMUN1(12)
        CHARACTER * 86  TITL
C
        equivalence(hh(1),hh1(1))
        equivalence(hh(106),hh2(1))
        equivalence(hh(211),hh3(1))
        equivalence(hhnam(1),hhnam1(1))
        equivalence(hhnam(106),hhnam2(1))
        equivalence(hhnam(211),hhnam3(1))
C
        SAVE
C
        DATA  center/  7,   8,   9,  34,  52,  54,  57,
     &                58,  59,  60,  61,  62,  74,  85,
     &                97,  98,  99/
C
C       TABLE 3 - TYPE AND VALUE OF LEVELS (PDS OCTETS 10, 11 AND 12)
C
        DATA  hhh  /   1,   2,   3,   4,   5,   6,   7,
     &                 8,   9,  20, 100, 101, 102, 103,
     &               104, 105, 106, 107, 108, 109, 110,
     &               111, 112, 113, 114, 115, 116, 117,
     &               119, 120, 121, 125, 126, 128, 141,
     &               160, 200, 201, 204, 212, 213, 214,
     &               222, 223, 224, 232, 233, 234, 209,
     &               210, 211, 242, 243, 244, 246, 247,
     &               206, 207, 248, 249, 251, 252, 235,
     &               236, 237, 238, 215, 220, 239, 240,
     &               245, 253, 254/
       DATA  hhhnam/'SFC ','CBL ','CTL ','0DEG','ADCL','MWSL','TRO ',
     &              'NTAT','SEAB','TMPL','ISBL','ISBY','MSL ','GPML',
     &              'GPMY','HTGL','HTGY','SIGL','SIGY','HYBL','HYBY',
     &              'DBLL','DBLY','THEL','THEY','SPDL','SPDY','PVL ',
     &              'ETAL','ETAY','IBYH','HGLH','ISBP','SGYH','IBYM',
     &              'DBSL','EATM','EOCN','HTFL','LCBL','LCTL','LCY ',
     &              'MCBL','MCTL','MCY ','HCBL','HCTL','HCY ','BCBL',
     &              'BCTL','BCY ','CCBL','CCTL','CCY ','MTHE','EHLT',
     &              'GCBL','GCTL','SCBL','SCTL','DCBL','DCTL','OITL',
     &              'OLYR','OBML','OBIL','CEIL','PBLR','S26C','OMXL',
     &              'LLTW','LBLS','HTLS'/
C
C       GRIB TABLE VERSION 2 (PDS OCTET 4 = 2)
C
        DATA  hh1  /
     &                 1,   2,   3,   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,  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/
        DATA  hh2  /
     &               107, 108, 109, 110, 111, 112, 113,
     &               114, 115, 116, 117, 121, 122, 123,
     &               124, 125, 126, 127, 128, 129, 130,
     &               131, 132, 133, 134, 135, 136, 137,
     &               138, 139, 140, 141, 142, 143, 144,
     &               145, 146, 147, 148, 149, 150, 151,
     &               152, 153, 154, 155, 156, 157, 158,
     &               159, 160, 161, 162, 163, 164, 165,
     &               166, 167, 168, 169, 172, 173, 174,
     &               175, 176, 177, 181, 182, 183, 184,
     &               189, 190, 191, 192, 193, 194, 195,
     &               196, 197, 201, 204, 205, 206, 207,
     &               208, 209, 211, 212, 213, 214, 215,
     &               216, 217, 218, 219, 220 ,221, 222,
     &               223, 226, 227, 228, 229, 231, 232/
        DATA  hh3  /
     &               233, 234, 235, 237, 238, 239, 241,
     &               242, 243, 244, 245, 246, 247, 248,
     &               249, 250, 251, 252, 253, 254, 255,
     &                 4, 118, 119, 120, 170, 171, 178,
     &               179, 185, 186, 187, 198, 199, 200,
     &               224, 225, 230, 180, 202, 210, 240/
       DATA  hhnam1/
     &' PRES ',' PRMSL',' PTEND',' ICAHT',' GP   ',' HGT  ',' DIST ',
     &' HSTDV',' TOZNE',' TMP  ',' VTMP ',' POT  ',' EPOT ',' T MAX',
     &' T MIN',' DPT  ',' DEPR ',' LAPR ',' VIS  ',' RDSP1',' RDSP2',
     &' RDSP3',' PLI  ',' TMP A',' PRESA',' GP A ',' WVSP1',' WVSP2',
     &' WVSP3',' WDIR ',' WIND ',' U GRD',' V GRD',' STRM ',' V POT',
     &' MNTSF',' SGCVV',' V VEL',' DZDT ',' ABS V',' ABS D',' REL V',
     &' REL D',' VUCSH',' VVCSH',' DIR C',' SP C ',' UOGRD',' VOGRD',
     &' SPF H',' R H  ',' MIXR ',' P WAT',' VAPP ',' SAT D',' EVP  ',
     &' C ICE',' PRATE',' TSTM ',' A PCP',' NCPCP',' ACPCP',' SRWEQ',
     &' WEASD',' SNO D',' MIXHT',' TTHDP',' MTHD ',' MTH A',' T CDC',
     &' CDCON',' L CDC',' M CDC',' H CDC',' C WAT',' BLI  ',' SNO C',
     &' SNO L',' WTMP ',' LAND ',' DSL M',' SFC R',' ALBDO',' TSOIL',
     &' SOILM',' VEG  ',' SALTY',' DEN  ',' WATR ',' ICE C',' ICETK',
     &' DICED',' SICED',' U ICE',' V ICE',' ICE G',' ICE D',' SNO M',
     &' HTSGW',' WVDIR',' WVHGT',' WVPER',' SWDIR',' SWELL',' SWPER'/
        DATA  hhnam2/
     &' DIRPW',' PERPW',' DIRSW',' PERSW',' NSWRS',' NLWRS',' NSWRT',
     &' NLWRT',' LWAVR',' SWAVR',' G RAD',' LHTFL',' SHTFL',' BLYDP',
     &' U FLX',' V FLX',' WMIXE',' IMG D',' MSLSA',' MSLMA',' MSLET',
     &' LFT X',' 4LFTX',' K X  ',' S X  ',' MCONV',' VW SH',' TSLSA',
     &' BVF2 ',' PV MW',' CRAIN',' CFRZR',' CICEP',' CSNOW',' SOILW',
     &' PEVPR',' CWORK',' U-GWD',' V-GWD',' PV   ',' COVMZ',' COVTZ',
     &' COVTM',' CLWMR',' O3MR ',' GFLUX',' CIN  ',' CAPE ',' TKE  ',
     &' CONDP',' CSUSF',' CSDSF',' CSULF',' CSDLF',' CFNSF',' CFNLF',
     &' VBDSF',' VDDSF',' NBDSF',' NDDSF',' M FLX',' LMH  ',' LMV  ',
     &' MLYNO',' NLAT ',' ELON ',' LPS X',' LPS Y',' HGT X',' HGT Y',
     &' VPTMP',' HLCY ',' PROB ',' PROBN',' POP  ',' CPOFP',' CPOZP',
     &' USTM ',' VSTM ',' ICWAT',' DSWRF',' DLWRF',' UVI  ',' MSTAV',
     &' SFEXC',' MIXLY',' USWRF',' ULWRF',' CDLYR',' CPRAT',' TTDIA',
     &' TTRAD',' TTPHY',' PREIX',' TSD1D',' NLGSP',' HPBL ',' 5WAVH',
     &' CNWAT',' BMIXL',' AMIXL',' PEVAP',' SNOHF',' MFLUX',' DTRF '/
        DATA  hhnam3/
     &' UTRF ',' BGRUN',' SSRUN',' O3TOT',' SNOWC',' SNO T',' LRGHR',
     &' CNVHR',' CNVMR',' SHAHR',' SHAMR',' VDFHR',' VDFUA',' VDFVA',
     &' VDFMR',' SWHR ',' LWHR ',' CD   ',' FRICV',' RI   ',' MISS ',
     &' PVORT',' BRTMP',' LWRAD',' SWRAD',' RWMR ',' SNMR ',' ICMR ',
     &' GRMR ',' TURB ',' ICNG ',' LTNG ',' NCIP ',' EVBS ',' EVCW ',
     &' SOTYP',' VGTYP',' 5WAVA',' GUST ',' CWDI ',' TRANS',' COVTW'/
C
C       GRIB TABLE VERSION 128 (PDS OCTET 4 = 128)
C       ( OCEANGRAPHIC PARAMETER )
C
        DATA  hh128/
     &               128, 129, 130, 131, 132, 133, 134,
     &               135, 136, 137, 138, 139, 140, 141,
     &               142, 143, 144, 145, 146, 147, 148,
     &               149, 150, 151, 152, 153, 154, 155,
     &               156, 157, 158, 159, 160, 161, 162,
     &               163, 164, 165, 166, 167, 168, 169,
     &               170, 171, 172, 173, 174, 175, 176,
     &               177, 178, 179, 180, 181, 182, 183,
     &               184, 185, 186, 187, 188, 189, 190,
     &               191, 192, 193, 194, 254,  40,  41,
     &                42,  43/
        DATA  hhnam128/
     &'ADEPTH',' DEPTH',' ELEV ','MXEL24','MNEL24','      ','      ',
     &'  O2  ','  PO4 ','  NO3 ',' SIO4 ',' CO2AQ',' HCO3 ','  CO3 ',
     &' TCO2 ',' TALK ','      ','      ','  S11 ','  S12 ','  S22 ',
     &' INV1 ',' INV2 ','      ','      ','      ','      ',' WVRGH',
     &'WVSTRS',' WHITE','SWDIRW','SWFREW',' WVAGE','PWVAGE','      ',
     &'      ','      ',' LTURB','      ','      ','      ','      ',
     &'AIHFLX','AOHFLX','IOHFLX','IOSFLX','      ',' OMLT ',' OMLS ',
     &'P2OMLT',' OMLU ',' OMLV ',' ASHFL',' ASSFL',' BOTLD',' UBARO',
     &' VBARO',' INTFD',' WTMPC',' SALIN',' EMNP ','      ',' KENG ',
     &'      ',' LAYTH',' SSTT ',' SSST ','      ','A RAIN','A SNOW',
     &'A ICE ','A FRZR'/
C
C       GRIB TABLE VERSION 129 (PDS OCTET 4 = 129)
C
        DATA  hh129/
     &               128, 129, 130, 131, 132, 133, 134,
     &               135, 136, 137, 138, 139, 140, 141,
     &               142, 143, 144, 145, 146, 147, 148,
     &               149, 150, 151, 152, 153, 154, 155,
     &               156, 157, 158, 159, 160, 161, 162,
     &               163, 164, 165, 166, 167, 168, 169,
     &               170, 171, 172, 173, 174, 175, 176,
     &               177, 178, 179, 180, 181, 182, 183,
     &               184, 185, 186, 187, 188, 189, 190,
     &               191, 192, 193, 194, 195, 196, 197,
     &               198, 199, 200, 201, 201, 203, 204,
     &               205, 206, 207, 208, 209, 210, 211,
     &               212, 213, 214, 215, 216, 217, 218,
     &               219, 220, 221, 222, 223, 224, 225/
        DATA  hhnam129/
     &' PAOT ',' PAOP ','      ',' FRAIN',' FICE ',' FRIME',' CUEFI',
     &' TCOND',' TCOLW',' TCOLI',' TCOLR',' TCOLS',' TCOLC',' PLPL ',
     &' HLPL ',' CEMS ',' COPD ',' PSIZ ',' TCWAT',' TCICE',' WDIF ',
     &' WSTP ',' PTAN ',' PTNN ',' PTBN ',' PPAN ',' PPNN ',' PPBN ',
     &' PMTC ',' PMTF ',' AETMP',' AEDPT',' AESPH',' AEUWD',' AEVWD',
     &' LPMTF',' LIPMF',' REFZR',' REFZI',' REFZC',' TCLSW',' TCOLM',
     &' ELRDI',' TSEC ',' TSECA',' NUM  ',' AEPRS',' ICSEV',' ICPRB',
     &' LAVNI',' HAVNI',' FLGHT',' OZCON',' OZCAT',' VEDH ',' SIGV ',
     &' EWGT ',' CICEL',' CIVIS',' CIFLT',' LAVV ',' LOVV ',' USCT ',
     &' VSCT ',' LAUV ',' LOUV ',' TCHP ',' DBSS ',' ODHA ',' OHC  ',
     &' SSHG ',' SLTFL',' DUVB ',' CDUVB',' THFLX',' UVAR ',' VVAR ',
     &'UVVCC ',' MCLS ',' LAPP ',' LOPP ','      ',' REFO ',' REFD ',
     &' REFC ','SBT122','SBT123','SBT124','SBT125',' MINRH',' MAXRH',
     &' CEIL ','PBLREG','      ','      ','      ','      ','      '/
C
C       GRIB TABLE VERSION 130 (PDS OCTET 4 = 130)
C       ( FOR LAND MODELING AND LAND DATA ASSIMILATION )
C
        DATA  hh130/
     &               144, 145, 146, 147, 148, 149, 150,
     &               151, 152, 153, 154, 155, 156, 157,
     &               158, 159, 160, 161, 162, 163, 164,
     &               165, 166, 167, 168, 169, 170, 171,
     &               172, 173, 174, 175, 176, 177, 178,
     &               179, 180, 181, 182, 183, 184, 185,
     &               186, 187, 188, 189, 190, 191, 192,
     &               193, 194, 195, 196, 197, 198, 199,
     &               200, 201, 202, 203, 204, 205, 206,
     &               207, 208, 209, 210, 211, 212, 213,
     &               214, 215, 216, 217, 218, 219, 220,
     &               221, 222, 223, 224, 225, 226, 227,
     &               228, 229, 230, 231, 232, 233, 234,
     &               235, 236, 237, 238, 239, 240, 241,
     &               242, 243, 244, 245, 246, 247, 248,
     &               249, 250, 251, 252, 253, 254, 255/
        DATA  hhnam130/
     &' SOIL ',' PEVPR',' VEGT ',' BARET',' AVSFT',' RADT ',' SSTOR',
     &' LSOIL',' EWATR','      ',' LSPA ',' GFLUX',' CIN  ',' CAPE ',
     &' TKE  ','MXSALB',' SOILL',' ASNOW',' ARAIN',' GWREC',' QREC ',
     &' SNOWT',' VBDSF',' VDDSF',' NBDSF',' NDDSF','SNFALB','      ',
     &' M FLX','      ','      ','      ',' NLAT ',' ELON ','FLDCAP',
     &' ACOND',' SNOAG',' CCOND',' LAI  ',' SFCRH',' SALBD','      ',
     &'      ',' NDVI ',' DRIP ','VBSLAB','VWSALB','NBSALB','NWSALB',
     &'      ','      ','      ','      ','      ',' SBSNO',' EVBS ',
     &' EVCW ','      ','      ',' RSMIN',' DSWRF',' DLWRF','      ',
     &' MSTAV',' SFEXC','      ',' TRANS',' USWRF',' ULWRF','      ',
     &'      ','      ','      ','      ','      ',' WILT ',' FLDCP',
     &' HPBL ',' SLTYP',' CNWAT',' SOTYP',' VGTYP',' BMIXL',' AMIXL',
     &' PEVAP',' SNOHF',' SMREF',' SMDRY','      ','      ',' BGRUN',
     &' SSRUN','      ','      ',' SNOWC',' SNOT ',' POROS','      ',
     &'      ','      ','      ','      ',' RCS  ',' RCT  ',' RCQ  ',
     &' RCSOL','      ','      ','  CD  ',' FRICV',' RI   ','      '/
C
C       GRIB TABLE VERSION 140 (PDS OCTET 4 = 140)
C       ( FOR WORLD AREA FORECAST SYSTEM (WAF/ICAO)
C
        DATA  hh140/
     &               144, 145, 146, 147, 148, 149, 150,
     &               151, 152, 153, 154, 155, 156, 157,
     &               158, 159, 160, 161, 162, 163, 164,
     &               165, 166, 167, 168, 169, 170, 171,
     &               172, 173, 174, 175, 176, 177, 178,
     &               179, 180, 181, 182, 183, 184, 185,
     &               186, 187, 188, 189, 190, 191, 192,
     &               193, 194, 195, 196, 197, 198, 199,
     &               200, 201, 202, 203, 204, 205, 206,
     &               207, 208, 209, 210, 211, 212, 213,
     &               214, 215, 216, 217, 218, 219, 220,
     &               221, 222, 223, 224, 225, 226, 227,
     &               228, 229, 230, 231, 232, 233, 234,
     &               235, 236, 237, 238, 239, 240, 241,
     &               242, 243, 244, 245, 246, 247, 248,
     &               249, 250, 251, 252, 253, 254, 255/
        DATA  hhnam140/
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ',' MEIP ',' MAIP ',' MECTP',' MACTP',
     &' MECAT',' MACAT',' CBHE ',' PCBB ',' PCBT ',' PECBB',' PECBT',
     &' HCBB ',' HCBT ',' HECBB',' HECBT','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ','      ',
     &'      ','      ','      ','      ','      ','      ',' MISS '/
C
C       GRIB TABLE VERSION 131 (PDS OCTET 4 = 131)
C
        DATA  hh131/
     &                 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,  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, 130, 131, 132, 134, 135,
     &               136, 139, 140, 141, 142, 143, 144,
     &               145, 146, 147, 148, 149, 150, 151,
     &               152, 153, 155, 156, 157, 158, 159,
     &               160, 161, 162, 163, 164, 165, 166,
     &               167, 168, 169, 170, 171, 172, 173,
     &               174, 175, 176, 177, 178, 179, 180,
     &               181, 182, 183, 184, 187, 188, 189,
     &               190, 191, 192, 194, 196, 197, 198,
     &               199, 200, 202, 203, 204, 205, 206,
     &               207, 208, 210, 211, 212, 213, 214,
     &               216, 218, 219, 220, 221, 222, 223,
     &               224, 225, 226, 227, 228, 229, 230,
     &               231, 232, 233, 234, 235, 237, 238,
     &               239, 240, 241, 242, 243, 244, 245,
     &               246, 247, 248, 249, 250, 251, 252,
     &               253, 254, 255/
        DATA  hhnam131/
     &' PRES ',' PRMSL',' PTEND',' PVORT',' ICAHT',' GP   ',' HGT  ',
     &' DIST ',' HSTDV',' TOZNE',' TMP  ',' VTMP ',' POT  ',' EPOT ',
     &' TMAX ',' TMIN ',' DPT  ',' DEPR ',' LAPR ',' VIS  ',' RDSP1',
     &' RDSP2',' RDSP3',' PLI  ',' TMPA ',' PRESA',' GPA  ',' WVSP1',
     &' WVSP2',' WVSP3',' WDIR ',' WIND ',' UGRD ',' VGRD ',' STRM ',
     &' VPOT ',' MNTSF',' SGVCC',' VVEL ',' DZDT ',' ABSV ',' ABSD ',
     &' RELV ',' RELD ',' VUCSH',' VVCSH',' DIRC ',' SPC  ',' UOGRD',
     &' VOGRD',' SPFH ',' RH   ',' MIXR ',' PWAT ',' VAPP ',' SATD ',
     &' EVP  ',' CICE ',' PRATE',' TSTM ',' APCP ',' NCPCP',' ACPCP',
     &' SRWEQ',' WEASD',' SNOD ',' MIXHT',' TTHDP',' MTHD ',' MTHA ',
     &' TCDC ',' CDCON',' LCDC ',' MCDC ',' HCDC ',' CWAT ',' BLI  ',
     &' SNOC ',' SNOL ',' WTMP ',' LAND ',' DSLM ',' SFCR ',' ALBDO',
     &' TSOIL',' SOILM',' VEG  ',' SALTY',' DEN  ',' WATR ',' ICEC ',
     &' ICETK',' DICED',' SICED',' UICE ',' VICE ',' ICEG ',' ICED ',
     &' SNOM ',' HTSGW',' WVDIR',' WVHGT',' WVPER',' SWDIR',' SWELL',
     &' SWPER',' DIRPW',' PERPW',' DIRSW',' PERSW',' NSWRS',' NLWRS',
     &' NSWRT',' NLWRT',' LWAVR',' SWAVR',' GRAD ',' BRTMP',' LWRAD',
     &' SWRAT',' LHTFL',' SHTFL',' BLYDP',' UFLX ',' VFLX ',' WMIXE',
     &' IMGD ',' MSLSA',' MSLET',' LFTX ',' 4LFTX',' PRESN',' MCONV',
     &' VWSH ',' PVMW ',' CRAIN',' CFRZR',' CICEP',' CSNOW',' SOILW',
     &' PEVPR',' VEGT ',' BARET',' AVSFT',' RADT ',' SSTOR',' LSOIL',
     &' EWATR',' CLWMR',' GFLUX',' CIN  ',' CAPE ',' TKE  ','MXSALB',
     &' SOILL',' ASNOW',' ARAIN',' GWREC',' QREC ',' SNOWT',' VBDSF',
     &' VDDSF',' NBDSF',' NDDSF','SNFALB',' RLYRS',' FLX  ',' LMH  ',
     &' LMV  ',' MLYNO',' NLAT ',' ELON ',' ICMR ',' ACOND',' SNOAG',
     &' CCOND',' LAI  ',' SFCRH',' SALBD',' NDVI ',' DRIP ',' LANDN',
     &' HLCY ',' NLATN',' ELONN',' CPOFP',' USTM ',' VSTM ',' SBSNO',
     &' EVBS ',' EVCW ',' APCPN',' RSMIN',' DSWRF',' DLWRF','ACPCPN',
     &' MSTAV',' SFEXC',' TRANS',' USWRF',' ULWRF',' CDLYR',' CPRAT',
     &' TTRAD',' HGTN ',' WILT ',' FLDCP',' HPBL ',' SLTYP',' CNWAT',
     &' SOTYP',' VGTYP',' BMIXL',' AMIXL',' PEVAP',' SNOHF',' SMREF',
     &' SMDRY',' WVINC',' WCINC',' BGRUN',' SSRUN','MVCONV',' SNOWC',
     &' SNOT ',' POROS','WCCONV','WVUFLX','WVVFLX','WCUFLX','WCVFLX',
     &' RCS  ',' RCT  ',' RCQ  ',' RCSOL',' SWHR ',' LWHR ',' CD   ',
     &' FRICV',' RI   ',' MISS '/
C
C      ONE LINE CHANGE FOR HDS (IBM370) (ASCII NAME GRIB IN HEX)
C
C      DATA  GRIB  /Z47524942/
C
C      ONE LINE CHANGE FOR CRAY AND WORKSTATIONS
C
       DATA  grib  /'GRIB'/
C
C      TABLE O (PDS OCTET 5) NATIONAL/INTERNATIONAL
C      ORIGINATING CENTERS
C
       DATA  knam1 /
     & '   US  NWS - NCEP (WMC) ','   US NWS - NWSTG (WMC) ',
     & '   US  NWS - Other (WMC)','   JMA - Tokyo (RSMC)   ',
     & '   TPC (NHC),Miami(RSMC)','   CMS - Montreal (RSMC)',
     & '   U.S. Air Force - GWC ','   U.S. Navy - FNOC     ',
     & '   NOAA FSL, Boulder, CO','   NCAR, Boulder, CO    ',
     & '   SARGO, Landover, MD  ','   US Naval, Oceanograph',
     & '   U.K Met. Office RSMC)','   French WS - Toulouse ',
     & '   European Space Agency','   ECMWF (RSMC)         ',
     & '   De Bilt, Netherlands '/
C
C      TABLE C (PDS OCTET 26) NATIONAL SUB-CENTERS
C
       DATA  knam2 /
     & '   NCEP RE-ANALYSIS PRO.','   NCEP ENSEMBLE PRODUCT',
     & '   NCEP CENTRAL OPS.    ','   ENV. MODELING CENTER ',
     & '   HYDRO. PRED. CENTER  ','   OCEAN PRED. CENTER   ',
     & '   CLIMATE PRED. CENTER ','   AVIATION WEATHER CEN.',
     & '   STORM PRED. CENTER   ','   TROPICAL PRED. CENTER',
     & '   NWS TECH. DEV. LAB.  ','   NESDIS OFF. RES. APP.',
     & '   FAA                  ','   NWS MET. DEV. LAB.   ',
     & '   NARR  PROJECT        ','   SPACE ENV. CENTER    '/
       DATA  knam3 /
     & '   ABRFC  TULSA, OK     ','   AKRFC  ANCHORAGE, AK ',
     & '   CBRFC  SALT LAKE, UT ','   CNRFC  SACRAMENTO, CA',
     & '   LMRFC  SLIDEL, LA.   ','   MARFC  STATE CO., PA ',
     & '   MBRFC  KANSAS CITY MO','   NCRFC  MINNEAPOLIS MN',
     & '   NERFC  HARTFORD, CT. ','   NWRFC  PORTLAND, OR  ',
     & '   OHRFC  CINCINNATI, OH','   SERFC  ATLANTA, GA   ',
     & '   WGRFC  FORT WORTH, TX','   OUN  NORMAN OK WFO   '/
       DATA  month /'JAN','FEB','MAR','APR','MAY','JUN',
     &              'JUL','AUG','SEP','OCT','NOV','DEC'/
       DATA  scntr1/   1,   2,   3,   4,   5,   6,   7,
     &                 8,   9,  10,  11,  12,  13,  14,
     &                 15, 16/
       DATA  scntr2/ 150, 151, 152, 153, 154, 155, 156,
     &               157, 158, 159, 160, 161, 162, 170/
       DATA  timun /'HRS.','DAYS','MOS.','YRS.','DECS','NORM','CENS',
     &              2*'----','3HRS','6HRS','HDYS'/
       DATA  timun1/'HR','DY','MO','YR','DC','NO','CN',
     &              2*'--','3H','6H','HD'/
C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C           1.0 INITIALIZATION - NO. OF ENTRIES IN INDCATOR PARM.
C                              - NO. OF ENTRIES IN TYPE LEVEL
C                              - NO. OF ENTRIES IN CNTR PROD. DTA.
C                              - NO. OF ENTRIES IN SUB CNTR1 PROD. DTA.
C                              - NO. OF ENTRIES IN SUB CNTR2 PROD. DTA.
C
        iq    = 252
        is    =  73
        ic    =  17
        ih128 =  72
        ih129 =  98
        ih130 = 112
        ih140 = 112
        ih131 = 241
        ics1  =  16
        ics2  =  14
        ierr  =   0
C
        titl(1:30)  = '                              '
        titl(31:60) = '                              '
        titl(61:86) = '                          '
C
C ---------------------------------------------------------------------
C$           2.0 TEST SECTION 0 FOR ASCII 'GRIB'
C
         IF (grib(1:4) .NE. ipds0(1:4)) THEN
           ierr = 1
           RETURN
         ENDIF
C
C       TEST SECTION 0 FOR GRIB VERSION 1
C
        IF (mova2i(ipds0(8:8)).NE.1) THEN
          ierr = 2
          RETURN
        END IF
C
C       TEST THE LENGTH OF THE PDS (SECTION 1)
C
        lenpds  = mova2i(ipds(1:1)) * 65536 + mova2i(ipds(2:2)) * 256 +
     &            mova2i(ipds(3:3))
        IF (lenpds.GE.28) THEN
          idpds(1:28) = ipds(1:28)
        ELSE
          ierr = 3
          RETURN
        ENDIF
C
C       TEST PDS (OCTET 4) FOR PARAMETER TABLE VERSION
C       NUMBER 1 OR 2 OR 128, 129 OR 130 OR 131 OR 140
C
        iver = mova2i(idpds(4:4))
        IF (iver.GT.131) THEN
          ierr = 9
          RETURN
        END IF
C
C           4.0  FIND THE INDICATOR AND TYPE LEVELS
C
       iqq = mova2i(idpds(9:9))
       IF (iver.EQ.128) THEN
          DO k = 1, ih128
             IF (iqq .EQ. hh128(k)) THEN
                titl(21:27) = hhnam128(k)
                GO TO 150
             END IF
          END DO
       ELSE IF (iver.EQ.129) THEN
          DO k = 1, ih129
             IF (iqq .EQ. hh129(k)) THEN
                titl(21:27) = hhnam129(k)
                GO TO 150
             END IF
          END DO
       ELSE IF (iver.EQ.130) THEN
          DO k = 1, ih130
             IF (iqq .EQ. hh130(k)) THEN
                titl(21:27) = hhnam130(k)
                GO TO 150
             END IF
          END DO
       ELSE IF (iver.EQ.131) THEN
          DO k = 1, ih131
             IF (iqq .EQ. hh131(k)) THEN
                titl(21:27) = hhnam131(k)
                GO TO 150
             END IF
          END DO
       ELSE IF (iver.EQ.140) THEN
          DO k = 1, ih140
             IF (iqq .EQ. hh140(k)) THEN
                titl(21:27) = hhnam140(k)
                GO TO 150
             END IF
          END DO
       ELSE
         DO ii = 1,iq
           IF (iqq .EQ. hh(ii)) GO TO 100
         END DO
         IF (iqq.EQ.77.AND.iver.EQ.1) GO TO 100
         IF (iqq.EQ.24) GO TO 100
         ierr = 4
         RETURN
       END IF
C
 100   CONTINUE
         IF (iqq .NE. 77 .AND. iqq .NE. 24) THEN
           titl(21:27) = hhnam(ii)
         ELSE IF (iqq .EQ. 77) THEN
           titl(21:27) = ' CONDP '
C
C        TAKE OUT AFTER ALL PROGRAMS ARE CHANGED THAT USE 24
C        FOR TOTAL OZONE.
C
         ELSE IF (iqq .EQ. 24) THEN
           titl(21:27) = ' TOTO3 '
         END IF
         IF (iqq.EQ.137.AND.iver.EQ.1) titl(21:27) = ' VISIB '
 150   CONTINUE
         iss = mova2i(idpds(10:10))
C
C        CORRECTION FOR 'NLAT' 'ELON' 'L CDC' 'M CDC', 'H CDC',
C                       'T CDC'
C
         IF (iss.EQ.0.AND.(iqq.EQ.176.OR.iqq.EQ.177.
     &     or.iqq.EQ.71.OR.iqq.EQ.73.OR.iqq.EQ.74.
     &     or.iqq.EQ.72.OR.iqq.EQ.75.OR.iqq.EQ.213.
     &     or.iqq.EQ.173.OR.iqq.EQ.174)) THEN
           GO TO 300
         END IF
       DO jj = 1,is
         IF (iss .EQ. hhh(jj)) GO TO 200
       END DO
         ierr = 5
         RETURN
C
 200   CONTINUE
         IF (iss.EQ.4.OR.iss.EQ.5.OR.iss.EQ.20.OR.iss.EQ.100.OR.
     &     iss.EQ.103.OR.iss.EQ.105.OR.iss.EQ.107.OR.iss.EQ.109.OR.
     &     iss.EQ.111.OR.iss.EQ.113.OR.iss.EQ.115.OR.iss.EQ.117.OR.
     &     iss.EQ.119.OR.iss.EQ.125.OR.iss.EQ.126.OR.iss.EQ.160.OR.
     &     iss.EQ.236)THEN
           titl(16:20) = hhhnam(jj)
           level = mova2i(idpds(11:11)) * 256 + mova2i(idpds(12:12))
           IF (iss.EQ.107.OR.iss.EQ.119) THEN
             alevel = float(level) / 10000.0
             WRITE (titl(9:15),fmt='(F6.4)') alevel
           ELSE IF (iss.EQ.5) THEN
C             DO NOTHING
           ELSE
             WRITE (titl(11:15),fmt='(I4)') level
           END IF
         ELSE IF (iss.EQ.1.OR.iss.EQ.6.OR.iss.EQ.7.OR.iss.EQ.8.OR.
     &     iss.EQ.9  .OR.iss.EQ.102.OR.iss.EQ.200.OR.iss.EQ.201.OR.
     &     iss.EQ.204.OR.iss.EQ.212.OR.iss.EQ.213.OR.iss.EQ.214.OR.
     &     iss.EQ.222.OR.iss.EQ.223.OR.iss.EQ.224.OR.iss.EQ.232.OR.
     &     iss.EQ.233.OR.iss.EQ.234.OR.iss.EQ.209.OR.iss.EQ.210.OR.
     &     iss.EQ.211.OR.iss.EQ.242.OR.iss.EQ.243.OR.iss.EQ.244.OR.
     &     iss.EQ.245.OR.iss.EQ.235.OR.iss.EQ.237.OR.iss.EQ.238.OR.
     &     iss.EQ.246.OR.iss.EQ.247.OR.iss.EQ.206.OR.iss.EQ.207.OR.
     &     iss.EQ.248.OR.iss.EQ.249.OR.iss.EQ.251.OR.iss.EQ.252) THEN
           titl(16:20) = hhhnam(jj)
           titl(1:4)   = '    '
           titl(11:15) = '    '
         ELSE IF (iss.EQ.101.OR.iss.EQ.104.OR.iss.EQ.106.OR.iss.EQ.108.
     &     or.iss.EQ.110.OR.iss.EQ.112.OR.iss.EQ.114.OR.iss.EQ.116.OR.
     &     iss.EQ.120.OR.iss.EQ.121.OR.iss.EQ.128.OR.iss.EQ.141) THEN
           titl(6:11)  = hhhnam(jj)
           titl(16:20) = hhhnam(jj)
           itemp = mova2i(idpds(11:11))
           WRITE (unit=titl(1:4),fmt='(I4)')   itemp
           jtemp = mova2i(idpds(12:12))
           WRITE (unit=titl(11:15),fmt='(I4)') jtemp
         END IF
C
C               5.0 INSERT THE YEAR,DAY,MONTH AND TIME
C
 300   CONTINUE
       ihr   = mova2i(idpds(16:16))
       iday  = mova2i(idpds(15:15))
       imon  = mova2i(idpds(14:14))
       iyr   = mova2i(idpds(13:13))
       icen  = mova2i(idpds(25:25))
C
C      SUBTRACT 1 FROM CENTURY TO MAKE 4 DIGIT YEAR
C
       icen = icen - 1
C
       iyr  = icen * 100 + iyr
       WRITE (unit=titl(59:62),fmt='(I4)') iyr
       WRITE (unit=titl(52:53),fmt='(I2)') iday
       WRITE (unit=titl(38:49),fmt='(A6,I2.2,A2)') 'AFTER ',ihr,'Z '
       titl(55:57) = month(imon)
       fcstim      = mova2i(idpds(18:18))
       titl(34:36) = timun(fcstim)
       p1          = mova2i(idpds(19:19))
       p2          = mova2i(idpds(20:20))
       timerg      = mova2i(idpds(21:21))
       IF (timerg.EQ.10) THEN
         p1 = p1 * 256 + p2
         p2 = 0
       END IF
C
C      ADD CORRECTION IF BYTE 21 (TIME RANGE) IS 2
C
       IF (timerg.EQ.2) THEN
         titl(4:20)  = titl(11:27)
         titl(21:21) = ' '
         WRITE (unit=titl(22:24),fmt='(I3)') p1
         titl(25:28) = ' TO '
         WRITE (unit=titl(29:32),fmt='(I3)') p2
C
C      PRECIP AMOUNTS
C
       ELSE IF (timerg.EQ.4) THEN
         WRITE (unit=titl(29:32),fmt='(I3)') p2
         mtemp      = p2 - p1
         WRITE (unit=titl(2:4),fmt='(I3)') mtemp
         titl(6:7)  = timun1(fcstim)
         titl(8:12) = ' ACUM'
C
C      AVERAGE
C
       ELSE IF (timerg.EQ.3) THEN
         WRITE (unit=titl(29:32),fmt='(I3)') p2
         mtemp      = p2 - p1
         WRITE (unit=titl(2:4),fmt='(I3)') mtemp
         titl(6:7)  = timun1(fcstim)
         titl(8:12) = ' AVG'
C
C      CLIMATOLOGICAL MEAN VALUE
C
       ELSE IF (timerg.EQ.51) THEN
         WRITE (unit=titl(29:32),fmt='(I3)') p2
         mtemp      = p2 - p1
         WRITE (unit=titl(2:4),fmt='(I3)') mtemp
         titl(6:7)  = timun1(fcstim)
         titl(8:12) = ' AVG'
       ELSE
         WRITE (unit=titl(29:32),fmt='(I3)') p1
       ENDIF
C
C      TEST FOR ANALYSIS (MAKE CORRECTION IF MODEL IS ANALYSIS)
C
       IF (timerg.EQ.0.AND.p1.EQ.0) THEN
          titl(29:42) = ' ANALYSIS VT '
          model       = mova2i(idpds(6:6))
          IF (model.EQ.10.OR.model.EQ.39.OR.model.EQ.45.OR.
     &        model.EQ.53.OR.model.EQ.68.OR.model.EQ.69.OR.
     &        model.EQ.70.OR.model.EQ.73.OR.model.EQ.74.OR.
     &        model.EQ.75.OR.model.EQ.76.OR.model.EQ.77.OR.
     &        model.EQ.78.OR.model.EQ.79.OR.model.EQ.80.OR.
     &        model.EQ.83.OR.model.EQ.84.OR.model.EQ.85.OR.
     &        model.EQ.86.OR.model.EQ.87.OR.model.EQ.88.OR.
     &        model.EQ.90.OR.model.EQ.91.OR.model.EQ.92.OR.
     &        model.EQ.105.OR.model.EQ.110.OR.model.EQ.150.OR.
     &        model.EQ.151) THEN
              titl(29:42) = ' 00-HR FCST  '
          ENDIF
       ENDIF
C
C      TEST FOR 00-HR FCST (INITIALIZED ANALYSIS)
C
       IF (timerg.EQ.1.AND.p1.EQ.0) THEN
          titl(29:42) = ' 00-HR FCST  '
       ENDIF
C
C$            3.0 FIND WHO GENERATED THE CODE
C$                CHECK FOR SUB-CENTERS
C
       igenc = mova2i(idpds(5:5))
       isubc = mova2i(idpds(26:26))
C
C      TEST FOR SUB-CENTERS WHEN CENTER IS 7
C
 
       IF (isubc.NE.0.AND.igenc.EQ.7) THEN
         DO j = 1,ics1
           IF (isubc .EQ. scntr1(j)) THEN
             titl(63:86) = knam2(j)
             RETURN
           END IF
         END DO
         ierr = 7
       END IF
C
C      TEST FOR SUB-CENTERS WHEN CENTER IS 9
C
       IF (isubc.NE.0.AND.igenc.EQ.9) THEN
         DO j = 1,ics2
           IF (isubc .EQ. scntr2(j)) THEN
             titl(63:86) = knam3(j)
             RETURN
           END IF
         END DO
         ierr = 8
       END IF
C
C      TEST TO SEE IF CENTER IN TABLES
C
       DO i = 1,ic
         IF (igenc .EQ. center(i)) THEN
           titl(63:86) = knam1(i)
           RETURN
         END IF
       END DO
C
       ierr = 6
       RETURN
       END