SUBROUTINE SN_IFSP ( rimnem, cimnem, iret ) C************************************************************************ C* SN_IFSP * C* * C* This subroutine initializes the interface mnemonic arrays and sets * C* the pointers within COMMON / RINTFP / and COMMON / CINTFP /. * C* * C* SN_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* C. Caruso Magee/NCEP 07/06 * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'sncmn.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' , 'SRMK' , + 'TOSD' , 'TOSDQA', 'TOSDQR', + 'SWEM' , 'SWEMQA', 'SWEMQR', + 'DOFS6' , 'DOFS6QA', 'DOSF6QR', + 'SWEM6' , 'SWEM6QA', 'SWEM6QR', + 'DOFS24' , 'DOFS24QA', 'DOFS24QR', + 'SWEM24' , 'SWEM24QA', 'SWEM24QR'/ C* Real interface mnemonics C* DATA ( cifmn ( i ), i = 1, NCIMN ) + / 'SNID' , 'SPRVID', + 'TOSDQD', 'SWEMQD', 'DOFS6QD', 'SWEM6QD', + 'DOFS24QD', 'SWEM24QD' / 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 ( 'SNID', cimnem, NCIMN, allok, icsnid, ier ) CALL DC_IFFP ( 'SPRVID', cimnem, NCIMN, allok, + icsprvid , ier ) CALL DC_IFFP ( 'TOSDQD', cimnem, NCIMN, allok, ictosdqd, ier ) CALL DC_IFFP ( 'SWEMQD', cimnem, NCIMN, allok, icswemqd, ier ) CALL DC_IFFP ( 'DOFS6QD', cimnem, NCIMN, allok, + icdofs6qd, ier ) CALL DC_IFFP ( 'SWEM6QD', cimnem, NCIMN, allok, + icswem6qd, ier ) CALL DC_IFFP ( 'DOFS24QD', cimnem, NCIMN, allok, + icdofs24qd, ier ) CALL DC_IFFP ( 'SWEM24QD', cimnem, NCIMN, allok, + icswem24qd, ier ) C C* Were all of the pointers properly set? C IF ( .not. allok ) THEN iret = -1 END IF C* RETURN END