SUBROUTINE UA_IFPT ( loglev, rimnem, cimnem, iret ) C************************************************************************ C* UA_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* UA_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* J. Ator/NCEP 12/97 * C* J. Ator/NCEP 03/98 Use DC_IFPC and DC_IFPR * C* D. Kidwell/NCEP 10/98 Added intf mnemonics to calling sequence* C* J. Ator/NCEP 08/99 Added LOGLEV to calling sequence * C* J. Ator/NCEP 10/99 Change /INTF mnemonics for cloud data, * C* clean up function declarations * C* J. Ator/NCEP 03/00 Print AWSB and AWSA as 2F5.1 * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) rimnem (*), cimnem (*) C* C* Format statements C* 111 FORMAT ( 5A10 ) 222 FORMAT ( 5F10.2 ) 333 FORMAT ( F3.0, 1x, F6.1, F7.0, 2F6.1, F5.0, F5.1, 2F5.1 ) C----------------------------------------------------------------------- iret = 0 C C* Print out all of the character interface values that are C* not "missing". C CALL DC_IFPC ( loglev, cimnem, civals, NCIMN, ierfpc ) C C* Print out all of the single-level real interface values C* that are not "missing". C CALL DC_IFPR ( loglev, rimnem, rivals, NRSIMN, ierfpr ) C C* Print out all of the multi-level interface values. C C* Cloud types. C WRITE ( UNIT = logmsg, FMT = 111 ) rimnem ( irnclt ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) WRITE ( UNIT = logmsg, FMT = 222 ) rivals ( irnclt ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) C nclt = INT ( rivals ( irnclt ) ) IF ( nclt .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = 111 ) rimnem ( ircltp (1) ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) DO jj = 1, nclt WRITE ( UNIT = logmsg, FMT = 222 ) + rivals ( ircltp (jj) ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) END DO END IF C C* Multi-level data. C WRITE ( UNIT = logmsg, FMT = 111 ) rimnem ( irnlev ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) WRITE ( UNIT = logmsg, FMT = 222 ) rivals ( irnlev ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) C nlev = INT ( rivals ( irnlev ) ) IF ( nlev .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 2A6, A7, A6, 5A5 )' ) + rimnem ( irvsig (1) ), rimnem ( irpres (1) ), + rimnem ( irhgtm (1) ), rimnem ( irtmpc (1) ), + rimnem ( irdwpc (1) ), rimnem ( irdrct (1) ), + rimnem ( irsped (1) ), rimnem ( irawsb (1) ), + rimnem ( irawsa (1) ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) DO jj = 1, nlev WRITE ( UNIT = logmsg, FMT = 333 ) + rivals ( irvsig (jj) ), rivals ( irpres (jj) ), + rivals ( irhgtm (jj) ), rivals ( irtmpc (jj) ), + rivals ( irdwpc (jj) ), rivals ( irdrct (jj) ), + rivals ( irsped (jj) ), rivals ( irawsb (jj) ), + rivals ( irawsa (jj) ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) END DO END IF C C* Report diagnostic codes. C WRITE ( UNIT = logmsg, FMT = 111 ) rimnem ( irnrdc ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) WRITE ( UNIT = logmsg, FMT = 222 ) rivals ( irnrdc ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) C nrdc = INT ( rivals ( irnrdc ) ) IF ( nrdc .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = 111 ) rimnem ( irurdc (1) ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) DO jj = 1, nrdc WRITE ( UNIT = logmsg, FMT = 222 ) + rivals ( irurdc (jj) ) CALL DC_WLOG ( loglev, 'UA', 1, logmsg, ierwlg ) END DO END IF C* RETURN END