/[MITgcm]/MITgcm/pkg/monitor/mon_out.F
ViewVC logotype

Contents of /MITgcm/pkg/monitor/mon_out.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.10 - (show annotations) (download)
Fri Sep 10 12:19:31 2004 UTC (19 years, 8 months ago) by edhill
Branch: MAIN
Changes since 1.9: +4 -1 lines 
 o overhaul of IO so that we now have flags for MDSIO and/or MNC
   - all verification tests compile and run with linux_ia32_g77
   - defaults are compatible with current input files--nothing
     should change if you were not previously using MNC
   - MNC output has been added in numerous places (eg. timeave)
     but there are still a few writes not yet do-able with MNC
     (this is in progress)
   - flags now allow for either/or/both use of MDSIO and MNC and
     documentation will soon follow
   - numerous small formatting cleanups for ProTeX
1 C $Header: /u/gcmpack/MITgcm/pkg/monitor/mon_out.F,v 1.9 2004/09/07 21:32:10 edhill Exp $
2 C $Name: $
3
4 #include "MONITOR_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: MON_OUT_I
9
10 C !INTERFACE:
11 SUBROUTINE MON_OUT_I( pref, value, foot, myThid )
12
13 C !DESCRIPTION:
14 C Formatted integer I/O for monitor print out.
15
16 C !INPUT PARAMETERS:
17 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 CHARACTER*(*) pref
21 INTEGER value
22 CHARACTER*(*) foot
23 INTEGER myThid
24 CEOP
25
26 CALL MON_OUT_ALL(pref, foot, 1, value, 0.0d0, myThid)
27 RETURN
28 END
29
30 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
31 CBOP
32 C !ROUTINE: MON_OUT_RS
33
34 C !INTERFACE:
35 SUBROUTINE MON_OUT_RS( pref, value, foot, myThid )
36
37 C !DESCRIPTION:
38 C Formatted RS I/O for monitor print out.
39
40 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 REAL*8 dtmp
50 dtmp = value
51
52 CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
53 RETURN
54 END
55
56 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
57 CBOP
58 C !ROUTINE: MON_OUT_RL
59
60 C !INTERFACE:
61 SUBROUTINE MON_OUT_RL( pref, value, foot, myThid )
62
63 C !DESCRIPTION:
64 C Formatted RL I/O for monitor print out.
65
66 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 CHARACTER*(*) pref
71 _RL value
72 CHARACTER*(*) foot
73 INTEGER myThid
74 CEOP
75 REAL*8 dtmp
76 dtmp = value
77
78 CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
79 RETURN
80 END
81
82 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83 CBOP 1
84 C !ROUTINE: MON_OUT_ALL
85
86 C !INTERFACE:
87 SUBROUTINE MON_OUT_ALL(
88 I pref, foot,
89 I itype, ival, dval,
90 I myThid )
91
92 C !DESCRIPTION:
93 C Formatted I/O for monitor output.
94
95 C !USES:
96 IMPLICIT NONE
97 #include "SIZE.h"
98 #include "EEPARAMS.h"
99 #include "PARAMS.h"
100 #ifdef ALLOW_MNC
101 #include "MNC_PARAMS.h"
102 #endif
103 #include "EESUPPORT.h"
104 #include "MONITOR.h"
105 INTEGER IFNBLNK
106 INTEGER ILNBLNK
107
108 C !INPUT PARAMETERS:
109 C pref - Field prefix ( ignored if == mon_string_none )
110 C foot - Field suffix ( ignored if == mon_string_none )
111 CHARACTER*(*) pref, foot
112 INTEGER itype
113 INTEGER ival
114 REAL*8 dval
115 INTEGER myThid
116 CEOP
117
118 C !LOCAL VARIABLES:
119 C msgBuf - Buffer for building output string
120 C lBuf - Buffer for length
121 C I0 - Temps used in calculating string length
122 CHARACTER*(MAX_LEN_MBUF) msgBuf
123 INTEGER lBuf
124 INTEGER i, I0,I1, IL
125 CHARACTER*(100) mon_vname
126 INTEGER nvname
127
128 msgBuf = ' '
129 lBuf = 0
130
131 DO i = 1,100
132 mon_vname(i:i) = ' '
133 ENDDO
134
135 I0 = IFNBLNK(mon_head)
136 I1 = ILNBLNK(mon_head)
137 IL = I1-I0+1
138 IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
139 msgBuf(1:IL) = mon_head
140 lBuf = IL+1
141 msgBuf(lBuf:lBuf) = ' '
142 ENDIF
143
144 IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
145 & lBuf+mon_prefL+1 .LE. MAX_LEN_MBUF ) THEN
146 lBuf = lBuf+1
147 msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
148 lBuf = lBuf+mon_prefL-1
149 mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
150 nvname = mon_prefL
151 ELSE
152 nvname = 0
153 ENDIF
154
155 I0 = IFNBLNK(pref)
156 I1 = ILNBLNK(pref)
157 IL = I1-I0+1
158 IF ( IL .GT. 0 ) THEN
159 IF ( pref(I0:I1) .NE. mon_string_none .AND.
160 & lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
161 lBuf = lBuf+1
162 msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
163 lBuf = lBuf+IL-1
164 mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
165 nvname = nvname + IL
166 ENDIF
167 ENDIF
168
169 I0 = IFNBLNK(foot)
170 I1 = ILNBLNK(foot)
171 IL = I1-I0+1
172 IF ( IL .GT. 0 ) THEN
173 IF ( foot(I0:I1) .NE. mon_string_none .AND.
174 & lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
175 lBuf = lBuf+1
176 msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
177 lBuf = lBuf+IL-1
178 mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
179 nvname = nvname + IL
180 ENDIF
181 ENDIF
182
183 C write(*,*) 'mon_vname = ''', mon_vname(1:nvname), ''''
184 C write(*,*) 'mon_write_mnc = ''', mon_write_mnc, ''''
185 C write(*,*) 'mon_write_stdout = ''', mon_write_stdout, ''''
186
187 msgBuf(35:35) = '='
188
189 _BEGIN_MASTER(myThid)
190 #ifdef ALLOW_USE_MPI
191 IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN
192 #endif /* ALLOW_USE_MPI */
193
194 IF (mon_write_stdout) THEN
195 IF (itype .EQ. 1)
196 & WRITE(msgBuf(36:57),'(1X,I21)') ival
197 IF (itype .EQ. 2)
198 & WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
199 CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
200 ENDIF
201
202 #ifdef ALLOW_MNC
203 IF (useMNC .AND. mon_write_mnc) THEN
204 CALL MNC_CW_APPEND_VNAME(
205 & mon_vname, '-_-_--__-__t', 0,0, myThid)
206 IF (itype .EQ. 1)
207 & CALL MNC_CW_I_W(
208 & 'I','monitor',1,1,mon_vname, ival, myThid)
209 IF (itype .EQ. 2)
210 & CALL MNC_CW_RL_W(
211 & 'D','monitor',1,1,mon_vname, dval, myThid)
212 ENDIF
213 #endif /* ALLOW_MNC */
214
215 #ifdef ALLOW_USE_MPI
216 ENDIF
217 #endif /* ALLOW_USE_MPI */
218 _END_MASTER()
219
220 RETURN
221 END
222
223 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  ViewVC Help
Powered by ViewVC 1.1.22