SUBROUTINE AL_IFSP ( rimnem, r8mnem, iret ) C************************************************************************ C* AL_IFSP * C* * C* This subroutine initializes the interface mnemonic arrays and sets * C* the pointers within COMMON / RINTFP /. * C* * C* AL_IFSP ( RIMNEM, R8MNEM, IRET ) * C* * C* Output parameters: * C* RIMNEM (*) CHAR* Interface mnemonics for real*4 * C* R8MNEM (*) CHAR* Interface mnemonics for real*8 * 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 07/02 * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'alcmn.cmn' C* CHARACTER*(*) rimnem (*), r8mnem (*) C* LOGICAL allok INTEGER iploc ( NRIMN ) CHARACTER rifmn ( NRIMN + NR8IMN )*8 C* C* Establish equivalance between iploc ( ) and COMMON / RINTFP / C* EQUIVALENCE ( iploc (1), iryear ) C* C* Real interface mnemonics. C* DATA ( rifmn (i), i = 1, (NRIMN + NR8IMN) ) + / 'YEAR' , 'MNTH' , 'DAYS' , 'HOUR' , 'MINU' , + 'SACYLN', 'ORBN' , 'SAID' , 'SCLF' , 'OBQL' , + 'CLATH' , 'CLONH' , 'SLHD1' / C----------------------------------------------------------------------- iret = 0 C C* Initialize the interface mnemonics. C DO i = 1, NRIMN rimnem ( i ) = rifmn ( i ) END DO C C* Initialize the real*8 interface mnemonics. C DO i = 1, NR8IMN r8mnem ( i ) = rifmn ( NRIMN + 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 real interface mnemonics. C DO ii = 1, NRIMN CALL DC_IFFP ( rimnem (ii), rimnem, NRIMN, allok, + iploc (ii), ier ) END DO C CALL DC_IFFP ( r8mnem (1), r8mnem, NR8IMN, allok, irslat, ier ) CALL DC_IFFP ( r8mnem (2), r8mnem, NR8IMN, allok, irslon, ier ) CALL DC_IFFP ( r8mnem (3), r8mnem, NR8IMN, allok, irshd1, ier ) C C* Were all of the pointers properly set? C IF ( .not. allok ) THEN iret = -1 END IF C* RETURN END