SUBROUTINE HY_IFSP ( rimnem, cimnem, iret ) C************************************************************************ C* HY_IFSP * C* * C* This subroutine initializes the interface mnemonic arrays and sets * C* the pointers within COMMON / RINTFP / and COMMON / CINTFP /. * C* * C* HY_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 'hycmn.cmn' C* CHARACTER*(*) rimnem (*), cimnem (*) C* LOGICAL allok INTEGER iploc ( NRSLMN ) 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' , + 'RFLO' , 'RSTG' , + 'PCP5M' , 'PCP5QA', 'PCP5QR', + 'PCP1H' , 'PCP1QA', 'PCP1QR', + 'PCP3H' , 'PCP3QA', 'PCP3QR', + 'PCP6H' , 'PCP6QA', 'PCP6QR', + 'PCP12H' , 'PCP12QA', 'PCP12QR', + 'PCP24H' , 'PCP24QA', 'PCP24QR'/ C* Real interface mnemonics C* DATA ( cifmn ( i ), i = 1, NCIMN ) + / 'HYID' , 'PRVID' , + 'PCP5QD', 'PCP1QD', 'PCP3QD', 'PCP6QD', + 'PCP12QD', 'PCP24QD' / 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, NRSLMN CALL DC_IFFP ( rimnem (ii), rimnem, NRIMN, allok, + iploc (ii), ier ) END DO C CALL DC_IFFP ( 'HYID' , cimnem, NCIMN, allok, ichyid, ier ) CALL DC_IFFP ( 'PRVID' , cimnem, NCIMN, allok, icprvid, ier ) CALL DC_IFFP ( 'PCP5QD', cimnem, NCIMN, allok, icpcp5qd, ier ) CALL DC_IFFP ( 'PCP1QD', cimnem, NCIMN, allok, icpcp1qd, ier ) CALL DC_IFFP ( 'PCP3QD', cimnem, NCIMN, allok, icpcp3qd, ier ) CALL DC_IFFP ( 'PCP6QD', cimnem, NCIMN, allok, icpcp6qd, ier ) CALL DC_IFFP ( 'PCP12QD', cimnem, NCIMN, allok, icpcp12qd, ier ) CALL DC_IFFP ( 'PCP24QD', cimnem, NCIMN, allok, icpcp24qd, ier ) C C* Were all of the pointers properly set? C IF ( .not. allok ) THEN iret = -1 END IF C* RETURN END