pkg/monitor/mon_out.F

C $Header: /u/gcmpack/MITgcm/pkg/monitor/mon_out.F,v 1.15 2006/02/24 18:55:28 edhill 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 "EESUPPORT.h"
#include "MONITOR.h"
      INTEGER IFNBLNK
      INTEGER ILNBLNK

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     !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)

      _BEGIN_MASTER(myThid)

#ifdef ALLOW_USE_MPI
      IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN
#endif /* ALLOW_USE_MPI */

        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  */

#ifdef ALLOW_USE_MPI
      ENDIF
#endif /* ALLOW_USE_MPI */

      _END_MASTER(myThid)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	edhill	1.16	C $Header: /u/gcmpack/MITgcm/pkg/monitor/mon_out.F,v 1.15 2006/02/24 18:55:28 edhill Exp $
2	cnh	1.1	C $Name: $
3
4	adcroft	1.3	#include "MONITOR_OPTIONS.h"
5	cnh	1.1
6	edhill	1.5	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7			CBOP
8			C !ROUTINE: MON_OUT_I
9
10			C !INTERFACE:
11	edhill	1.6	SUBROUTINE MON_OUT_I( pref, value, foot, myThid )
12	edhill	1.5
13			C !DESCRIPTION:
14			C Formatted integer I/O for monitor print out.
15
16			C !INPUT PARAMETERS:
17	edhill	1.6	C pref - Field prefix ( ignored if == mon_string_none )
18			C value - Value to print
19			C foot - Field suffix ( ignored if == mon_string_none )
20	cnh	1.1	CHARACTER() pref
21			INTEGER value
22			CHARACTER() foot
23	edhill	1.5	INTEGER myThid
24			CEOP
25	cnh	1.1
26	edhill	1.7	CALL MON_OUT_ALL(pref, foot, 1, value, 0.0d0, myThid)
27	edhill	1.6	RETURN
28			END
29	cnh	1.1
30	edhill	1.6	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
31			CBOP
32			C !ROUTINE: MON_OUT_RS
33	cnh	1.1
34	edhill	1.6	C !INTERFACE:
35			SUBROUTINE MON_OUT_RS( pref, value, foot, myThid )
36	cnh	1.1
37	edhill	1.6	C !DESCRIPTION:
38			C Formatted RS I/O for monitor print out.
39	cnh	1.1
40	edhill	1.6	C !INPUT PARAMETERS:
41			C pref - Field prefix ( ignored if == mon_string_none )
42			C value - Value to print
43			C foot - Field suffix ( ignored if == mon_string_none )
44			CHARACTER() pref
45			_RS value
46			CHARACTER() foot
47			INTEGER myThid
48			CEOP
49	edhill	1.7	REAL*8 dtmp
50			dtmp = value
51	cnh	1.1
52	edhill	1.7	CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
53	cnh	1.1	RETURN
54			END
55	edhill	1.5
56			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
57	edhill	1.6	CBOP
58			C !ROUTINE: MON_OUT_RL
59	edhill	1.5
60	edhill	1.6	C !INTERFACE:
61	edhill	1.7	SUBROUTINE MON_OUT_RL( pref, value, foot, myThid )
62	cnh	1.1
63	edhill	1.6	C !DESCRIPTION:
64			C Formatted RL I/O for monitor print out.
65	cnh	1.1
66	edhill	1.6	C !INPUT PARAMETERS:
67			C pref - Field prefix ( ignored if == mon_string_none )
68			C value - Value to print
69			C foot - Field suffix ( ignored if == mon_string_none )
70	cnh	1.1	CHARACTER() pref
71	edhill	1.6	_RL value
72	cnh	1.1	CHARACTER() foot
73	edhill	1.6	INTEGER myThid
74			CEOP
75	edhill	1.7	REAL*8 dtmp
76			dtmp = value
77	cnh	1.1
78	edhill	1.7	CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
79	edhill	1.6	RETURN
80			END
81	cnh	1.1
82	edhill	1.6	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
83			CBOP 1
84			C !ROUTINE: MON_OUT_ALL
85	cnh	1.1
86	edhill	1.6	C !INTERFACE:
87			SUBROUTINE MON_OUT_ALL(
88			I pref, foot,
89	edhill	1.7	I itype, ival, dval,
90	edhill	1.6	I myThid )
91	cnh	1.1
92	edhill	1.6	C !DESCRIPTION:
93			C Formatted I/O for monitor output.
94	cnh	1.1
95	edhill	1.6	C !USES:
96	cnh	1.1	IMPLICIT NONE
97			#include "SIZE.h"
98			#include "EEPARAMS.h"
99	dimitri	1.4	#include "PARAMS.h"
100			#include "EESUPPORT.h"
101	cnh	1.1	#include "MONITOR.h"
102	edhill	1.6	INTEGER IFNBLNK
103			INTEGER ILNBLNK
104
105			C !INPUT PARAMETERS:
106			C pref - Field prefix ( ignored if == mon_string_none )
107			C foot - Field suffix ( ignored if == mon_string_none )
108			CHARACTER() pref, foot
109			INTEGER itype
110			INTEGER ival
111	edhill	1.7	REAL*8 dval
112	edhill	1.6	INTEGER myThid
113			CEOP
114	cnh	1.1
115	edhill	1.6	C !LOCAL VARIABLES:
116			C msgBuf - Buffer for building output string
117			C lBuf - Buffer for length
118			C I0 - Temps used in calculating string length
119	cnh	1.1	CHARACTER*(MAX_LEN_MBUF) msgBuf
120			INTEGER lBuf
121	edhill	1.8	INTEGER i, I0,I1, IL
122			CHARACTER*(100) mon_vname
123			INTEGER nvname
124	edhill	1.12	INTEGER ivarr(1)
125			REAL*8 dvarr(1)
126
127	edhill	1.16	_BEGIN_MASTER(myThid)
128	cnh	1.1
129	edhill	1.16	#ifdef ALLOW_USE_MPI
130			IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN
131			#endif /* ALLOW_USE_MPI */
132	cnh	1.1
133	edhill	1.16	ivarr(1) = ival
134			dvarr(1) = dval
135
136			msgBuf = ' '
137			lBuf = 0
138
139			DO i = 1,100
140			mon_vname(i:i) = ' '
141			ENDDO
142
143			I0 = IFNBLNK(mon_head)
144			I1 = ILNBLNK(mon_head)
145			IL = I1-I0+1
146			IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
147			msgBuf(1:IL) = mon_head
148			lBuf = IL+1
149			msgBuf(lBuf:lBuf) = ' '
150			ENDIF
151
152			IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
153			& lBuf+mon_prefL+1 .LE. MAX_LEN_MBUF ) THEN
154	edhill	1.8	lBuf = lBuf+1
155	edhill	1.16	msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
156			lBuf = lBuf+mon_prefL-1
157			mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
158			nvname = mon_prefL
159			ELSE
160			nvname = 0
161	edhill	1.8	ENDIF
162	edhill	1.16
163			I0 = IFNBLNK(pref)
164			I1 = ILNBLNK(pref)
165			IL = I1-I0+1
166			IF ( IL .GT. 0 ) THEN
167			IF ( pref(I0:I1) .NE. mon_string_none .AND.
168			& lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
169			lBuf = lBuf+1
170			msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
171			lBuf = lBuf+IL-1
172			mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
173			nvname = nvname + IL
174			ENDIF
175			ENDIF
176
177			I0 = IFNBLNK(foot)
178			I1 = ILNBLNK(foot)
179			IL = I1-I0+1
180			IF ( IL .GT. 0 ) THEN
181			IF ( foot(I0:I1) .NE. mon_string_none .AND.
182			& lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
183			lBuf = lBuf+1
184			msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
185			lBuf = lBuf+IL-1
186			mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
187			nvname = nvname + IL
188			ENDIF
189	edhill	1.8	ENDIF
190	cnh	1.1
191	edhill	1.16	C write(,) 'mon_vname = ''', mon_vname(1:nvname), ''''
192			C write(,) 'mon_write_mnc = ''', mon_write_mnc, ''''
193			C write(,) 'mon_write_stdout = ''', mon_write_stdout, ''''
194
195			msgBuf(35:35) = '='
196
197			IF (mon_write_stdout) THEN
198			IF (itype .EQ. 1)
199			& WRITE(msgBuf(36:57),'(1X,I21)') ival
200			IF (itype .EQ. 2)
201			& WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
202			C & WRITE(msgBuf(35:57),'(1X,1P1E22.13E3)') dval
203
204			C Note that the above call fixes problems where there is
205			C insufficient space in the output format to handle variables
206			C such as 1.234500000E107 which, although they are wildly large,
207			C they may actually happen in some situations. But, changing
208			C the monitor output format also means changing the routines
209			C that parse the monitor output for testreport.
210	edhill	1.8
211	edhill	1.16	CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
212			ENDIF
213
214	edhill	1.8	#ifdef ALLOW_MNC
215	edhill	1.16	IF (useMNC .AND. mon_write_mnc) THEN
216			CALL MNC_CW_APPEND_VNAME(
217			& mon_vname, '-_-_--__-__t', 0,0, myThid)
218			IF (itype .EQ. 1)
219			& CALL MNC_CW_I_W(
220			& 'I',mon_fname,1,1,mon_vname, ivarr, myThid)
221			IF (itype .EQ. 2)
222			& CALL MNC_CW_RL_W(
223			& 'D',mon_fname,1,1,mon_vname, dvarr, myThid)
224			ENDIF
225	edhill	1.8	#endif /* ALLOW_MNC */
226
227	dimitri	1.4	#ifdef ALLOW_USE_MPI
228	edhill	1.16	ENDIF
229	dimitri	1.4	#endif /* ALLOW_USE_MPI */
230	edhill	1.16
231	edhill	1.14	_END_MASTER(myThid)
232	cnh	1.1
233			RETURN
234			END
235	edhill	1.6
236			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|