SUBROUTINE CN_IFPT ( loglev, rimnem, cimnem, iret ) C************************************************************************ C* CN_IFPT * C* * C* This subroutine prints the interface values arrays to the decoder * C* log if the verbosity level is LOGLEV or higher. * C* * C* CN_IFPT ( LOGLEV, RIMNEM, CIMNEM, IRET ) * C* * C* Input parameters: * C* LOGLEV INTEGER Verbosity level * C* RIMNEM (*) CHAR* Interface mnemonics for reals * C* CIMNEM (*) CHAR* Interface mnemonics for chars * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = normal return * C* * C** * C* Log: * C* S. Guan/NCEP 12/11 * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'cncmn.cmn' C* CHARACTER*(*) rimnem (*), cimnem (*) C----------------------------------------------------------------------- iret = 0 C ncsl = ( ictmpkqd - 1 ) CALL DC_IFPC ( loglev, cimnem, civals, ncsl, ierfpc ) C nrsl = ( irtmpk - 1 ) CALL DC_IFPR ( loglev, rimnem, rivals, nrsl, ierfpr ) C CALL CN_IFPQ ( loglev, rimnem, cimnem, + irtmpk, ictmpkqd, irtmpkqa, irtmpkqr, ierfpq ) CALL CN_IFPQ ( loglev, rimnem, cimnem, + irrelh, icrelhqd, irrelhqa, irrelhqr, ierfpq ) CALL CN_IFPQ ( loglev, rimnem, cimnem, + irdrct, icdrctqd, irdrctqa, irdrctqr, ierfpq ) CALL CN_IFPQ ( loglev, rimnem, cimnem, + irsped, icspedqd, irspedqa, irspedqr, ierfpq ) CALL CN_IFPQ ( loglev, rimnem, cimnem, + irrpcp, icrpcpqd, irrpcpqa, irrpcpqr, ierfpq ) CALL CN_IFPQ ( loglev, rimnem, cimnem, + irsrdf, icsrdfqd, irsrdfqa, irsrdfqr, ierfpq ) C IF ( rivals ( irnpcp ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 6A10 )' ) + rimnem ( irnpcp ), rimnem ( irtphr (1) ), + rimnem ( irtpcp (1) ), cimnem ( ictpcpqd (1) ), + rimnem ( irtpcpqa (1) ), rimnem ( irtpcpqr (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) WRITE ( UNIT = logmsg, + FMT = '( 3F10.3, 5X, A5, 2F10.3 )' ) + rivals ( irnpcp ), rivals ( irtphr (1) ), + rivals ( irtpcp (1) ), civals ( ictpcpqd (1) ), + rivals ( irtpcpqa (1) ), rivals ( irtpcpqr (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) C IF ( rivals ( irnpcp ) .gt. 1 ) THEN DO jj = 2, rivals ( irnpcp ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 2F10.3, 5X, A5, 2F10.3 )' ) + rivals ( irtphr (jj) ), + rivals ( irtpcp (jj) ), civals ( ictpcpqd (jj) ), + rivals ( irtpcpqa (jj) ), rivals ( irtpcpqr (jj) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) END DO END IF C END IF C IF ( rivals ( irnsol1 ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 10A9 )' ) + rimnem ( irnsol1 ), rimnem ( irslin1 (1) ), + rimnem ( irsolm1 (1) ), cimnem ( icsolmqd1 (1) ), + rimnem ( irsolmqa1 (1) ), rimnem ( irsolmqr1 (1) ), + rimnem ( irsolt1 (1) ), cimnem ( icsoltqd1 (1) ), + rimnem ( irsoltqa1 (1) ), rimnem ( irsoltqr1 (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) WRITE ( UNIT = logmsg, + FMT = '( 2F9.2, 2(F9.2, 4X, A5, 2F9.2 ))' ) + rivals ( irnsol1 ), rivals ( irslin1 (1) ), + rivals ( irsolm1 (1) ), civals ( icsolmqd1 (1) ), + rivals ( irsolmqa1 (1) ), rivals ( irsolmqr1 (1) ), + rivals ( irsolt1 (1) ), civals ( icsoltqd1 (1) ), + rivals ( irsoltqa1 (1) ), rivals ( irsoltqr1 (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) C IF ( rivals ( irnsol1 ) .gt. 1 ) THEN DO jj = 2, INT ( rivals ( irnsol1 ) ) WRITE ( UNIT = logmsg, + FMT = '( 9X, F9.2, 2(F9.2, 4X, A5, 2F9.2 ))' ) + rivals ( irslin1 (jj) ), + rivals ( irsolm1 (jj) ), civals ( icsolmqd1 (jj) ), + rivals ( irsolmqa1(jj) ), rivals ( irsolmqr1(jj) ), + rivals ( irsolt1 (jj) ), civals ( icsoltqd1 (jj) ), + rivals ( irsoltqa1 (jj) ), rivals ( irsoltqr1 (jj) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) END DO END IF END IF C IF ( rivals ( irnsol2 ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 10A9 )' ) + rimnem ( irnsol2 ), rimnem ( irslin2 (1) ), + rimnem ( irsolm2 (1) ), cimnem ( icsolmqd2 (1) ), + rimnem ( irsolmqa2 (1) ), rimnem ( irsolmqr2 (1) ), + rimnem ( irsolt2 (1) ), cimnem ( icsoltqd2 (1) ), + rimnem ( irsoltqa2 (1) ), rimnem ( irsoltqr2 (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) WRITE ( UNIT = logmsg, + FMT = '( 2F9.2, 2(F9.2, 4X, A5, 2F9.2 ))' ) + rivals ( irnsol2 ), rivals ( irslin2 (1) ), + rivals ( irsolm2 (1) ), civals ( icsolmqd2 (1) ), + rivals ( irsolmqa2 (1) ), rivals ( irsolmqr2 (1) ), + rivals ( irsolt2 (1) ), civals ( icsoltqd2 (1) ), + rivals ( irsoltqa2 (1) ), rivals ( irsoltqr2 (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) C IF ( rivals ( irnsol2 ) .gt. 1 ) THEN DO jj = 2, INT ( rivals ( irnsol2 ) ) WRITE ( UNIT = logmsg, + FMT = '( 9X, F9.2, 2(F9.2, 4X, A5, 2F9.2 ))' ) + rivals ( irslin2 (jj) ), + rivals ( irsolm2 (jj) ), civals ( icsolmqd2 (jj) ), + rivals ( irsolmqa2 (jj) ), rivals ( irsolmqr2 (jj) ), + rivals ( irsolt2 (jj) ), civals ( icsoltqd2 (jj) ), + rivals ( irsoltqa2 (jj) ), rivals ( irsoltqr2 (jj) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) END DO END IF END IF C IF ( rivals ( irnsol3 ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 10A9 )' ) + rimnem ( irnsol3 ), rimnem ( irslin3 (1) ), + rimnem ( irsolm3 (1) ), cimnem ( icsolmqd3 (1) ), + rimnem ( irsolmqa3 (1) ), rimnem ( irsolmqr3 (1) ), + rimnem ( irsolt3 (1) ), cimnem ( icsoltqd3 (1) ), + rimnem ( irsoltqa3 (1) ), rimnem ( irsoltqr3 (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) WRITE ( UNIT = logmsg, + FMT = '( 2F9.2, 2(F9.2, 4X, A5, 2F9.2 ))' ) + rivals ( irnsol3 ), rivals ( irslin3 (1) ), + rivals ( irsolm3 (1) ), civals ( icsolmqd3 (1) ), + rivals ( irsolmqa3 (1) ), rivals ( irsolmqr3 (1) ), + rivals ( irsolt3 (1) ), civals ( icsoltqd3 (1) ), + rivals ( irsoltqa3 (1) ), rivals ( irsoltqr3 (1) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) C IF ( rivals ( irnsol3 ) .gt. 1 ) THEN DO jj = 2, INT ( rivals ( irnsol3 ) ) WRITE ( UNIT = logmsg, + FMT = '( 9X, F9.2, 2(F9.2, 4X, A5, 2F9.2 ))' ) + rivals ( irslin3 (jj) ), + rivals ( irsolm3 (jj) ), civals ( icsolmqd3 (jj) ), + rivals ( irsolmqa3 (jj) ), rivals ( irsolmqr3 (jj) ), + rivals ( irsolt3 (jj) ), civals ( icsoltqd3 (jj) ), + rivals ( irsoltqa3 (jj) ), rivals ( irsoltqr3 (jj) ) CALL DC_WLOG ( loglev, 'DC', 2, logmsg, ierwlg ) END DO END IF END IF C C* RETURN END