SUBROUTINE LS_IFPT ( rimnem, cimnem, iret ) C************************************************************************ C* LS_IFPT * C* * C* This subroutine prints the interface values arrays to the decoder * C* log if the verbosity level is 3 or higher. * C* * C* LS_IFPT ( RIMNEM, CIMNEM, IRET ) * C* * C* Input parameters: * C* NRSLMN INTEGER Number of real single-level * C* interface mnemonics * C* NCIMN INTEGER Number of char interface * C* mnemonics * C* NRIMN INTEGER Number of real interface * C* mnemonics * C* RIMNEM (*) REAL Real interface mnemonics array * C* CIMNEM (*) CHAR* Char interface mnemonics array * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = Normal return * C* * C** * C* Log: * C* D. Kidwell/NCEP 10/97 Adapted from AF_IFPT * C* R. Hollern/NCEP 1/98 Changes based on MA_IFPT * C* D. Kidwell/NCEP 5/98 Call DC_IFPC, DC_IFPR, 'LS' -> 'DC' in * C* WLOG calls * C* R. Hollern/NCEP 1/99 Initialized interface mnemonics and * C* added interface mnemonic arrays to * C* calling sequence * C* R. Hollern/NCEP 8/99 Got report obs time from interface * C* array and added code to print sec4 data * C* R. Hollern/NCEP 1/00 Modified supplementary wind data, cloud * C* data, and precipitation data print logic* C* R. Hollern/NCEP 1/00 Removed the code to print raw report * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER rimnem ( NRIMN )*8, cimnem ( NCIMN )*8 C------------------------------------------------------------------------ iret = 0 loglvl = 3 C C* Print all of the single-level character interface values C* that are not missing. C CALL DC_IFPC ( loglvl, cimnem, civals, NCIMN, ierf ) C C* Print all of the single-level real interface values C* that are not missing. C CALL DC_IFPR ( loglvl, rimnem, rivals, NRSLMN, ierf ) C C* Print all of the multi-level interface values. C C* Print the cloud level data. C IF ( rivals ( irnclo ) .gt. 0 ) THEN C WRITE ( UNIT = logmsg, FMT = '( 8A10 )' ) + rimnem ( irnclo ), + rimnem ( irvsso (1) ), rimnem ( irclam (1) ), + rimnem ( ircltp (1) ), rimnem ( irhocb (1) ), + rimnem ( irctds (1) ), rimnem ( irhoct (1) ), + rimnem ( ircsec (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:80), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 8F10.2 )' ) + rivals ( irnclo ), + rivals ( irvsso (1) ), rivals ( irclam (1) ), + rivals ( ircltp (1) ), rivals ( irhocb (1) ), + rivals ( irctds (1) ), rivals ( irhoct (1) ), + rivals ( ircsec (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:80), ierwlg ) IF ( rivals ( irnclo ) .gt. 1 ) THEN DO jj = 2, rivals ( irnclo ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 7F10.2 )' ) + rivals ( irvsso ( jj ) ), rivals ( irclam ( jj ) ), + rivals ( ircltp ( jj ) ), rivals ( irhocb ( jj ) ), + rivals ( irctds ( jj ) ), rivals ( irhoct ( jj ) ), + rivals ( ircsec ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:80), + ierwlg ) END DO END IF C END IF C C* Print the precipitation data. C IF ( rivals ( irnpcv ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 3A10 )' ) + rimnem ( irnpcv ), + rimnem ( irpprd (1) ), rimnem ( irpamt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 3F10.2 )' ) + rivals ( irnpcv ), + rivals ( irpprd (1) ), rivals ( irpamt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), ierwlg ) IF ( rivals ( irnpcv ) .gt. 1 ) THEN DO jj = 2, rivals ( irnpcv ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 2F10.2 )' ) + rivals ( irpprd ( jj ) ), rivals ( irpamt ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), + ierwlg ) END DO END IF END IF C C* Print wave data. C IF ( rivals ( irnswv ) .gt. 0 ) THEN C WRITE ( UNIT = logmsg, FMT = '( 4A10 )' ) + rimnem ( irnswv ), + rimnem ( irdosw (1) ), + rimnem ( irposw (1) ), rimnem ( irhosw (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierw ) WRITE ( UNIT = logmsg, FMT = '( 4F10.2 )' ) + rivals ( irnswv ), + rivals ( irdosw (1) ), + rivals ( irposw (1) ), rivals ( irhosw (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierw ) C IF ( rivals ( irnswv ) .gt. 1 ) THEN DO jj = 2, rivals ( irnswv ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 3F10.2 )' ) + rivals ( irdosw ( jj ) ), + rivals ( irposw ( jj ) ), rivals ( irhosw ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (:50), ierw ) END DO END IF C END IF C C* Print the supplementary wind data. C IF ( rivals ( irnspw ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 4A10 )' ) + rimnem ( irnspw ), + rimnem ( irspwp (1) ), rimnem ( irspws (1) ), + rimnem ( irspwt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 4F10.2 )' ) + rivals ( irnspw ), + rivals ( irspwp (1) ), rivals ( irspws (1) ), + rivals ( irspwt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), ierwlg ) IF ( rivals ( irnspw ) .gt. 1 ) THEN DO jj = 2, rivals ( irnspw ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 4F10.2 )' ) + rivals ( irspwp ( jj ) ), rivals ( irspws ( jj ) ), + rivals ( irspwt ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), + ierwlg ) END DO END IF END IF C* RETURN END