C $Header: /u/gcmpack/MITgcm/pkg/monitor/mon_out.F,v 1.17 2006/10/17 18:22:33 jmc Exp $
C $Name: $
#include "MONITOR_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: MON_OUT_I
C !INTERFACE:
SUBROUTINE MON_OUT_I( pref, value, foot, myThid )
C !DESCRIPTION:
C Formatted integer I/O for monitor print out.
C !INPUT PARAMETERS:
C pref - Field prefix ( ignored if == mon_string_none )
C value - Value to print
C foot - Field suffix ( ignored if == mon_string_none )
CHARACTER*(*) pref
INTEGER value
CHARACTER*(*) foot
INTEGER myThid
CEOP
CALL MON_OUT_ALL(pref, foot, 1, value, 0.0d0, myThid)
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: MON_OUT_RS
C !INTERFACE:
SUBROUTINE MON_OUT_RS( pref, value, foot, myThid )
C !DESCRIPTION:
C Formatted RS I/O for monitor print out.
C !INPUT PARAMETERS:
C pref - Field prefix ( ignored if == mon_string_none )
C value - Value to print
C foot - Field suffix ( ignored if == mon_string_none )
CHARACTER*(*) pref
_RS value
CHARACTER*(*) foot
INTEGER myThid
CEOP
REAL*8 dtmp
dtmp = value
CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: MON_OUT_RL
C !INTERFACE:
SUBROUTINE MON_OUT_RL( pref, value, foot, myThid )
C !DESCRIPTION:
C Formatted RL I/O for monitor print out.
C !INPUT PARAMETERS:
C pref - Field prefix ( ignored if == mon_string_none )
C value - Value to print
C foot - Field suffix ( ignored if == mon_string_none )
CHARACTER*(*) pref
_RL value
CHARACTER*(*) foot
INTEGER myThid
CEOP
REAL*8 dtmp
dtmp = value
CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C !ROUTINE: MON_OUT_ALL
C !INTERFACE:
SUBROUTINE MON_OUT_ALL(
I pref, foot,
I itype, ival, dval,
I myThid )
C !DESCRIPTION:
C Formatted I/O for monitor output.
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "MONITOR.h"
C !INPUT PARAMETERS:
C pref - Field prefix ( ignored if == mon_string_none )
C foot - Field suffix ( ignored if == mon_string_none )
CHARACTER*(*) pref, foot
INTEGER itype
INTEGER ival
REAL*8 dval
INTEGER myThid
CEOP
C === Functions ====
INTEGER IFNBLNK
INTEGER ILNBLNK
LOGICAL MASTER_CPU_IO
EXTERNAL
C !LOCAL VARIABLES:
C msgBuf - Buffer for building output string
C lBuf - Buffer for length
C I0 - Temps used in calculating string length
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER lBuf
INTEGER i, I0,I1, IL
CHARACTER*(100) mon_vname
INTEGER nvname
INTEGER ivarr(1)
REAL*8 dvarr(1)
IF ( MASTER_CPU_IO(myThid) ) THEN
ivarr(1) = ival
dvarr(1) = dval
msgBuf = ' '
lBuf = 0
DO i = 1,100
mon_vname(i:i) = ' '
ENDDO
I0 = IFNBLNK(mon_head)
I1 = ILNBLNK(mon_head)
IL = I1-I0+1
IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
msgBuf(1:IL) = mon_head
lBuf = IL+1
msgBuf(lBuf:lBuf) = ' '
ENDIF
IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
& lBuf+mon_prefL+1 .LE. MAX_LEN_MBUF ) THEN
lBuf = lBuf+1
msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
lBuf = lBuf+mon_prefL-1
mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
nvname = mon_prefL
ELSE
nvname = 0
ENDIF
I0 = IFNBLNK(pref)
I1 = ILNBLNK(pref)
IL = I1-I0+1
IF ( IL .GT. 0 ) THEN
IF ( pref(I0:I1) .NE. mon_string_none .AND.
& lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
lBuf = lBuf+1
msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
lBuf = lBuf+IL-1
mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
nvname = nvname + IL
ENDIF
ENDIF
I0 = IFNBLNK(foot)
I1 = ILNBLNK(foot)
IL = I1-I0+1
IF ( IL .GT. 0 ) THEN
IF ( foot(I0:I1) .NE. mon_string_none .AND.
& lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
lBuf = lBuf+1
msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
lBuf = lBuf+IL-1
mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
nvname = nvname + IL
ENDIF
ENDIF
C write(*,*) 'mon_vname = ''', mon_vname(1:nvname), ''''
C write(*,*) 'mon_write_mnc = ''', mon_write_mnc, ''''
C write(*,*) 'mon_write_stdout = ''', mon_write_stdout, ''''
msgBuf(35:35) = '='
IF (mon_write_stdout) THEN
IF (itype .EQ. 1)
& WRITE(msgBuf(36:57),'(1X,I21)') ival
IF (itype .EQ. 2)
& WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
C & WRITE(msgBuf(35:57),'(1X,1P1E22.13E3)') dval
C Note that the above call fixes problems where there is
C insufficient space in the output format to handle variables
C such as 1.234500000E107 which, although they are wildly large,
C they may actually happen in some situations. But, changing
C the monitor output format also means changing the routines
C that parse the monitor output for testreport.
CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
ENDIF
#ifdef ALLOW_MNC
IF (useMNC .AND. mon_write_mnc) THEN
CALL MNC_CW_APPEND_VNAME(
& mon_vname, '-_-_--__-__t', 0,0, myThid)
IF (itype .EQ. 1)
& CALL MNC_CW_I_W(
& 'I',mon_fname,1,1,mon_vname, ivarr, myThid)
IF (itype .EQ. 2)
& CALL MNC_CW_RL_W(
& 'D',mon_fname,1,1,mon_vname, dvarr, myThid)
ENDIF
#endif /* ALLOW_MNC */
C-- endif master cpu io
ENDIF
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|