SUBROUTINE MN_IFSP ( rimnem, cimnem, iret ) C************************************************************************ C* MN_IFSP * C* * C* This subroutine initializes the interface mnemonic arrays and sets * C* the pointers within COMMON / RINTFP / and COMMON / CINTFP /. * C* * C* MN_IFSP ( RIMNEM, CIMNEM, IRET ) * C* * C* Output parameters: * C* RIMNEM (*) CHAR* Interface mnemonics for reals * C* CIMNEM (*) CHAR* Interface mnemonics for chars * C* IRET INTEGER Return code * C* 0 = normal return * C* -1 = one or more pointers * C* could not be set * C* * C** * C* Log: * C* J. Ator/NCEP 06/01 * C* C. Caruso Magee/NCEP 09/06 Add roadway data * C* J. Ator/NCEP 04/12 Add decoding of VIS * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'mncmn.cmn' C* CHARACTER*(*) rimnem (*), cimnem (*) C* LOGICAL allok INTEGER iploc ( NRSIMN ) CHARACTER rifmn ( NRIMN )*8, cifmn ( NCIMN )*8 C* C* Establish equivalence between iploc ( ) and COMMON / RINTFP / C* EQUIVALENCE ( iploc (1), iryear ) C* DATA ( rifmn ( i ), i = 1, NRIMN ) + / 'YEAR' , 'MNTH' , 'DAYS' , 'HOUR' , 'MINU' , + 'SLAT' , 'SLON' , 'SELV' , 'GUDR' , 'GUMS' , + 'SLMT' , 'SOLT' , + 'PRES' , 'PRESQA', 'PRESQR', 'ALTM' , 'ALTMQA', 'ALTMQR', + 'TMPK' , 'TMPKQA', 'TMPKQR', 'DWPK' , 'DWPKQA', 'DWPKQR', + 'DRCT' , 'DRCTQA', 'DRCTQR', 'SPED' , 'SPEDQA', 'SPEDQR', + 'RPCP' , 'RPCPQA', 'RPCPQR', 'HOVI' , 'HOVIQA', 'HOVIQR', + 'NPCP' , 'TPHR' , 'TPCP' , 'TPCPQA', 'TPCPQR', + MPM1T4 * ' ' , + 'NSRD' , 'TPMI' , 'DFSORD', 'DRSORD', + MRM1T3 * ' ' , + 'NRDW' , 'RDTM' , 'RLFT' , 'RLIP' , 'RDLD' , 'RDST', + MRM1T5 * ' ' / C* Real interface mnemonics C* DATA ( cifmn ( i ), i = 1, NCIMN ) + / 'STID' , 'PRVID' , 'SPRVID', + 'PRESQD', 'ALTMQD', 'TMPKQD', 'DWPKQD', 'DRCTQD', 'SPEDQD', + 'RPCPQD', 'HOVIQD', 'TPCPQD', MPM1 * ' ' / C* Character interface mnemonics C----------------------------------------------------------------------- iret = 0 C C* Initialize the interface mnemonics. C DO i = 1, NRIMN rimnem ( i ) = rifmn ( i ) END DO DO i = 1, NCIMN cimnem ( i ) = cifmn ( i ) END DO C C* The logical variable "allok" is initially set to .true. but will C* be reset to .false. if any of the pointers cannot be set. C allok = .true. C C* Set the pointers for the single-level interface mnemonics. C DO ii = 1, NRSIMN CALL DC_IFFP ( rimnem (ii), rimnem, NRIMN, allok, + iploc (ii), ier ) END DO C CALL DC_IFFP ( 'STID' , cimnem, NCIMN, allok, icstid , ier ) CALL DC_IFFP ( 'PRVID' , cimnem, NCIMN, allok, icprvid , ier ) CALL DC_IFFP ( 'SPRVID', cimnem, NCIMN, allok, icsprvid, ier ) CALL DC_IFFP ( 'PRESQD', cimnem, NCIMN, allok, icpresqd, ier ) CALL DC_IFFP ( 'ALTMQD', cimnem, NCIMN, allok, icaltmqd, ier ) CALL DC_IFFP ( 'TMPKQD', cimnem, NCIMN, allok, ictmpkqd, ier ) CALL DC_IFFP ( 'DWPKQD', cimnem, NCIMN, allok, icdwpkqd, ier ) CALL DC_IFFP ( 'DRCTQD', cimnem, NCIMN, allok, icdrctqd, ier ) CALL DC_IFFP ( 'SPEDQD', cimnem, NCIMN, allok, icspedqd, ier ) CALL DC_IFFP ( 'RPCPQD', cimnem, NCIMN, allok, icrpcpqd, ier ) CALL DC_IFFP ( 'HOVIQD', cimnem, NCIMN, allok, ichoviqd, ier ) C C* Set the pointers for the multi-level interface mnemonics. C CALL DC_IFFP ( 'NPCP' , rimnem, NRIMN, allok, irnpcp, ier ) CALL DC_IFFP ( 'TPHR' , rimnem, NRIMN, allok, + irtphr (1) , ier ) CALL DC_IFMP ( 4, MXPCP, irtphr, ier ) CALL DC_IFFP ( 'TPCP' , rimnem, NRIMN, allok, + irtpcp (1) , ier ) CALL DC_IFMP ( 4, MXPCP, irtpcp, ier ) CALL DC_IFFP ( 'TPCPQA', rimnem, NRIMN, allok, + irtpcpqa (1), ier ) CALL DC_IFMP ( 4, MXPCP, irtpcpqa, ier ) CALL DC_IFFP ( 'TPCPQR', rimnem, NRIMN, allok, + irtpcpqr (1), ier ) CALL DC_IFMP ( 4, MXPCP, irtpcpqr, ier ) CALL DC_IFFP ( 'TPCPQD', cimnem, NCIMN, allok, + ictpcpqd (1), ier ) CALL DC_IFMP ( 1, MXPCP, ictpcpqd, ier ) C CALL DC_IFFP ( 'NSRD' , rimnem, NRIMN, allok, irnsrd, ier ) CALL DC_IFFP ( 'TPMI' , rimnem, NRIMN, allok, + irtpmi (1) , ier ) CALL DC_IFMP ( 3, MXSRD, irtpmi, ier ) CALL DC_IFFP ( 'DFSORD', rimnem, NRIMN, allok, + irdfsord (1), ier ) CALL DC_IFMP ( 3, MXSRD, irdfsord, ier ) CALL DC_IFFP ( 'DRSORD', rimnem, NRIMN, allok, + irdrsord (1), ier ) CALL DC_IFMP ( 3, MXSRD, irdrsord, ier ) C CALL DC_IFFP ( 'NRDW' , rimnem, NRIMN, allok, irnrdw, ier ) CALL DC_IFFP ( 'RDTM' , rimnem, NRIMN, allok, + irrdtm (1) , ier ) CALL DC_IFMP ( 5, MXRDW, irrdtm, ier ) CALL DC_IFFP ( 'RLFT', rimnem, NRIMN, allok, + irrlft (1), ier ) CALL DC_IFMP ( 5, MXRDW, irrlft, ier ) CALL DC_IFFP ( 'RLIP', rimnem, NRIMN, allok, + irrlip (1), ier ) CALL DC_IFMP ( 5, MXRDW, irrlip, ier ) CALL DC_IFFP ( 'RDLD', rimnem, NRIMN, allok, + irrdld (1), ier ) CALL DC_IFMP ( 5, MXRDW, irrdld, ier ) CALL DC_IFFP ( 'RDST', rimnem, NRIMN, allok, + irrdst (1), ier ) CALL DC_IFMP ( 5, MXRDW, irrdst, ier ) C C* Were all of the pointers properly set? C IF ( .not. allok ) THEN iret = -1 END IF C* RETURN END