SUBROUTINE CN_IFSP ( rimnem, cimnem, iret )
C************************************************************************
C* CN_IFSP *
C* *
C* This subroutine initializes the interface mnemonic arrays and sets *
C* the pointers within COMMON / RINTFP / and COMMON / CINTFP /. *
C* *
C* CN_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* S. Guan/NCEP 12/11 *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'cncmn.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' , 'PLTP' , 'GUDR' , 'GUMS' ,
+ 'TMPK' , 'TMPKQA', 'TMPKQR', 'RELH' , 'RELHQA', 'RELHQR',
+ 'DRCT' , 'DRCTQA', 'DRCTQR', 'SPED' , 'SPEDQA', 'SPEDQR',
+ 'RPCP' , 'RPCPQA', 'RPCPQR', 'SRDF' , 'SRDFQA', 'SRDFQR',
+ 'NPCP' , 'TPMI' , 'TPHR' , 'TPCP' , 'TPCPQA', 'TPCPQR',
+ MPM1T5 * ' ' ,
+ 'NSOL1' , 'SLIN1' ,
+ 'SOLM1' ,
+ 'SOLMQA1', 'SOLMQR1',
+ 'SOLT1' ,
+ 'SOLTQA1', 'SOLTQR1',
+ MLM1T7 * ' ' ,
+ 'NSOL2' , 'SLIN2' ,
+ 'SOLM2' ,
+ 'SOLMQA2', 'SOLMQR2',
+ 'SOLT2' ,
+ 'SOLTQA2', 'SOLTQR2',
+ MLM1T7 * ' ' ,
+ 'NSOL3' , 'SLIN3' ,
+ 'SOLM3' ,
+ 'SOLMQA3', 'SOLMQR3',
+ 'SOLT3' ,
+ 'SOLTQA3', 'SOLTQR3',
+ MLM1T7 * ' ' /
C* Real interface mnemonics
C*
DATA ( cifmn ( i ), i = 1, NCIMN )
+ / 'STID' , 'PRVID' ,
+ 'TMPKQD', 'RELHQD', 'DRCTQD', 'SPEDQD',
+ 'RPCPQD', 'SRDFQD', 'TPCPQD', MPM1 * ' ',
+ 'SOLMQD1', MSLM1 * ' ',
+ 'SOLTQD1', MSLM1 * ' ',
+ 'SOLMQD2', MSLM1 * ' ',
+ 'SOLTQD2', MSLM1 * ' ',
+ 'SOLMQD3', MSLM1 * ' ',
+ 'SOLTQD3', MSLM1 * ' ' /
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 ( 'TMPKQD', cimnem, NCIMN, allok, ictmpkqd, ier )
CALL DC_IFFP ( 'RELHQD', cimnem, NCIMN, allok, icrelhqd, 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 ( 'SRDFQD', cimnem, NCIMN, allok, icsrdfqd, 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 ( 5, MXPCP, irtphr, ier )
CALL DC_IFFP ( 'TPMI' , rimnem, NRIMN, allok,
+ irtpmi (1) , ier )
CALL DC_IFMP ( 5, MXPCP, irtpmi, ier )
CALL DC_IFFP ( 'TPCP' , rimnem, NRIMN, allok,
+ irtpcp (1) , ier )
CALL DC_IFMP ( 5, MXPCP, irtpcp, ier )
CALL DC_IFFP ( 'TPCPQA', rimnem, NRIMN, allok,
+ irtpcpqa (1), ier )
CALL DC_IFMP ( 5, MXPCP, irtpcpqa, ier )
CALL DC_IFFP ( 'TPCPQR', rimnem, NRIMN, allok,
+ irtpcpqr (1), ier )
CALL DC_IFMP ( 5, MXPCP, irtpcpqr, ier )
CALL DC_IFFP ( 'TPCPQD', cimnem, NCIMN, allok,
+ ictpcpqd (1), ier )
CALL DC_IFMP ( 1, MXPCP, ictpcpqd, ier )
C
CALL DC_IFFP ( 'NSOL1' , rimnem, NRIMN, allok, irnsol1, ier )
CALL DC_IFFP ( 'SLIN1' , rimnem, NRIMN, allok,
+ irslin1 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irslin1, ier )
CALL DC_IFFP ( 'SOLM1' , rimnem, NRIMN, allok,
+ irsolm1 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irsolm1, ier )
CALL DC_IFFP ( 'SOLMQA1', rimnem, NRIMN, allok,
+ irsolmqa1 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsolmqa1, ier )
CALL DC_IFFP ( 'SOLMQR1', rimnem, NRIMN, allok,
+ irsolmqr1 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsolmqr1, ier )
CALL DC_IFFP ( 'SOLMQD1', cimnem, NCIMN, allok,
+ icsolmqd1 (1), ier )
CALL DC_IFMP ( 1, MXSOL, icsolmqd1, ier )
CALL DC_IFFP ( 'SOLT1' , rimnem, NRIMN, allok,
+ irsolt1 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irsolt1, ier )
CALL DC_IFFP ( 'SOLTQA1', rimnem, NRIMN, allok,
+ irsoltqa1 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsoltqa1, ier )
CALL DC_IFFP ( 'SOLTQR1', rimnem, NRIMN, allok,
+ irsoltqr1 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsoltqr1, ier )
CALL DC_IFFP ( 'SOLTQD1', cimnem, NCIMN, allok,
+ icsoltqd1 (1), ier )
CALL DC_IFMP ( 1, MXSOL, icsoltqd1, ier )
C
CALL DC_IFFP ( 'NSOL2' , rimnem, NRIMN, allok, irnsol2, ier )
CALL DC_IFFP ( 'SLIN2' , rimnem, NRIMN, allok,
+ irslin2 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irslin2, ier )
CALL DC_IFFP ( 'SOLM2' , rimnem, NRIMN, allok,
+ irsolm2 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irsolm2, ier )
CALL DC_IFFP ( 'SOLMQA2', rimnem, NRIMN, allok,
+ irsolmqa2 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsolmqa2, ier )
CALL DC_IFFP ( 'SOLMQR2', rimnem, NRIMN, allok,
+ irsolmqr2 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsolmqr2, ier )
CALL DC_IFFP ( 'SOLMQD2', cimnem, NCIMN, allok,
+ icsolmqd2 (1), ier )
CALL DC_IFMP ( 1, MXSOL, icsolmqd2, ier )
CALL DC_IFFP ( 'SOLT2' , rimnem, NRIMN, allok,
+ irsolt2 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irsolt2, ier )
CALL DC_IFFP ( 'SOLTQA2', rimnem, NRIMN, allok,
+ irsoltqa2 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsoltqa2, ier )
CALL DC_IFFP ( 'SOLTQR2', rimnem, NRIMN, allok,
+ irsoltqr2 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsoltqr2, ier )
CALL DC_IFFP ( 'SOLTQD2', cimnem, NCIMN, allok,
+ icsoltqd2 (1), ier )
CALL DC_IFMP ( 1, MXSOL, icsoltqd2, ier )
C
CALL DC_IFFP ( 'NSOL3' , rimnem, NRIMN, allok, irnsol3, ier )
CALL DC_IFFP ( 'SLIN3' , rimnem, NRIMN, allok,
+ irslin3 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irslin3, ier )
CALL DC_IFFP ( 'SOLM3' , rimnem, NRIMN, allok,
+ irsolm3 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irsolm3, ier )
CALL DC_IFFP ( 'SOLMQA3', rimnem, NRIMN, allok,
+ irsolmqa3 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsolmqa3, ier )
CALL DC_IFFP ( 'SOLMQR3', rimnem, NRIMN, allok,
+ irsolmqr3 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsolmqr3, ier )
CALL DC_IFFP ( 'SOLMQD3', cimnem, NCIMN, allok,
+ icsolmqd3 (1), ier )
CALL DC_IFMP ( 1, MXSOL, icsolmqd3, ier )
CALL DC_IFFP ( 'SOLT3' , rimnem, NRIMN, allok,
+ irsolt3 (1) , ier )
CALL DC_IFMP ( 7, MXSOL, irsolt3, ier )
CALL DC_IFFP ( 'SOLTQA3', rimnem, NRIMN, allok,
+ irsoltqa3 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsoltqa3, ier )
CALL DC_IFFP ( 'SOLTQR3', rimnem, NRIMN, allok,
+ irsoltqr3 (1), ier )
CALL DC_IFMP ( 7, MXSOL, irsoltqr3, ier )
CALL DC_IFFP ( 'SOLTQD3', cimnem, NCIMN, allok,
+ icsoltqd3 (1), ier )
CALL DC_IFMP ( 1, MXSOL, icsoltqd3, ier )
C
C* Were all of the pointers properly set?
C
IF ( .not. allok ) THEN
iret = -1
END IF
C*
RETURN
END