SUBROUTINE TG_IFSP ( rimnem, cimnem, iret ) C************************************************************************ C* TG_IFSP * C* * C* This subroutine initializes the interface mnemonic arrays and sets * C* the pointers within COMMON / RINTFP / and COMMON / CINTFP /. * C* * C* TG_IFSP ( RIMNEM, CIMNEM, IRET ) * C* * C* Input parameters: * C* NRIMN INTEGER Total number of real interface * C* mnemnonics * C* NRSLMN INTEGER Number of real single-level * C* real interface mnemnonics * C* NCIMN INTEGER Total number of character * C* interface mnemnonics * C* MXTIDL INTEGER Max number of tidal elevations * 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* R. Hollern/NCEP 8/00 * C************************************************************************ INCLUDE 'tgcmn.cmn' C* CHARACTER*(*) rimnem (*), cimnem (*) C* LOGICAL allok INTEGER iploc (NRSLMN) CHARACTER rifmn ( NRIMN )*8, cifmn ( NCIMN )*8 C* C* Establish array equivalence to COMMON / RINTFP / C* EQUIVALENCE ( iploc (1), iryear ) C* DATA ( rifmn (i), i = 1, NRSLMN ) / + 'YEAR' , 'MNTH' , 'DAYS' , 'HOUR' , 'MINU' , + 'SLAT' , 'SLON' , 'SELV' , 'AMCK' , 'MMCK' , + 'TMPC' , 'PRLC' , 'DRCT' , 'SPED' , 'SSTK' , + 'AWCK' , 'MWCK' , 'TPMI' , 'STIMI' , 'ITSO' , + 'TOST' / C* DATA ( rifmn (i), i = NRSLMN+1, NRIMN ) / + 'NTID' , 'TERC' , 'MRTE' , + MXTID1 * ' '/ C* Real interface mnemonics. C* DATA ( cifmn (i), i = 1, NCIMN ) / 'STID' / 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 i = 1, NRSLMN CALL DC_IFFP ( rimnem ( i ), rimnem, NRIMN, allok, + iploc ( i ), ier ) END DO C CALL DC_IFFP ( 'STID', cimnem, NCIMN, allok, icstid, ier ) C C* Set the pointers for tide elevation series. C CALL DC_IFFP ( 'NTID', rimnem, NRIMN, allok, irntid, ier ) CALL DC_IFFP ( 'TERC', rimnem, NRIMN, allok, irterc(1), ier ) CALL DC_IFMP ( 2, MXTIDL, irterc, ier ) CALL DC_IFFP ( 'MRTE', rimnem, NRIMN, allok, irmrte(1), ier ) CALL DC_IFMP ( 2, MXTIDL, irmrte, ier ) C C* Were all of the pointers properly set? C IF ( .not. allok ) THEN iret = -1 END IF C* RETURN END