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

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

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

Revision 1.17 - (hide annotations) (download)
Tue Oct 17 18:22:33 2006 UTC (17 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint59, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58t_post, checkpoint63g, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint58w_post, checkpoint58q_post, mitgcm_mapl_00, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint58r_post, checkpoint65o, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint62b, checkpoint58v_post, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint61f, checkpoint58x_post, checkpoint61n, checkpoint59j, checkpoint61q, checkpoint61e, checkpoint58u_post, checkpoint58s_post, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Changes since 1.16: +23 -27 lines 
use function "MASTER_CPU_IO" to hide EESUPPORT.h from TAF.
1 jmc 1.17 C $Header: /u/gcmpack/MITgcm/pkg/monitor/mon_out.F,v 1.16 2006/06/22 14:44:47 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 jmc 1.17 C Formatted integer I/O for monitor print out.
15 edhill 1.5
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 jmc 1.17 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 cnh 1.1 #include "MONITOR.h"
101 edhill 1.6
102     C !INPUT PARAMETERS:
103     C pref - Field prefix ( ignored if == mon_string_none )
104     C foot - Field suffix ( ignored if == mon_string_none )
105     CHARACTER*(*) pref, foot
106     INTEGER itype
107     INTEGER ival
108 edhill 1.7 REAL*8 dval
109 edhill 1.6 INTEGER myThid
110     CEOP
111 cnh 1.1
112 jmc 1.17 C === Functions ====
113     INTEGER IFNBLNK
114     INTEGER ILNBLNK
115     LOGICAL MASTER_CPU_IO
116     EXTERNAL MASTER_CPU_IO
117    
118 edhill 1.6 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 cnh 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
123     INTEGER lBuf
124 edhill 1.8 INTEGER i, I0,I1, IL
125     CHARACTER*(100) mon_vname
126     INTEGER nvname
127 edhill 1.12 INTEGER ivarr(1)
128     REAL*8 dvarr(1)
129    
130 jmc 1.17 IF ( MASTER_CPU_IO(myThid) ) THEN
131 cnh 1.1
132 edhill 1.16 ivarr(1) = ival
133     dvarr(1) = dval
134 jmc 1.17
135 edhill 1.16 msgBuf = ' '
136     lBuf = 0
137 jmc 1.17
138 edhill 1.16 DO i = 1,100
139     mon_vname(i:i) = ' '
140     ENDDO
141 jmc 1.17
142 edhill 1.16 I0 = IFNBLNK(mon_head)
143     I1 = ILNBLNK(mon_head)
144     IL = I1-I0+1
145     IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
146     msgBuf(1:IL) = mon_head
147     lBuf = IL+1
148     msgBuf(lBuf:lBuf) = ' '
149     ENDIF
150 jmc 1.17
151 edhill 1.16 IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
152     & lBuf+mon_prefL+1 .LE. MAX_LEN_MBUF ) THEN
153 edhill 1.8 lBuf = lBuf+1
154 edhill 1.16 msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
155     lBuf = lBuf+mon_prefL-1
156     mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
157     nvname = mon_prefL
158     ELSE
159     nvname = 0
160 edhill 1.8 ENDIF
161 jmc 1.17
162 edhill 1.16 I0 = IFNBLNK(pref)
163     I1 = ILNBLNK(pref)
164     IL = I1-I0+1
165     IF ( IL .GT. 0 ) THEN
166 jmc 1.17 IF ( pref(I0:I1) .NE. mon_string_none .AND.
167 edhill 1.16 & lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
168     lBuf = lBuf+1
169     msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
170     lBuf = lBuf+IL-1
171     mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
172     nvname = nvname + IL
173     ENDIF
174     ENDIF
175 jmc 1.17
176 edhill 1.16 I0 = IFNBLNK(foot)
177     I1 = ILNBLNK(foot)
178     IL = I1-I0+1
179     IF ( IL .GT. 0 ) THEN
180 jmc 1.17 IF ( foot(I0:I1) .NE. mon_string_none .AND.
181 edhill 1.16 & lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
182     lBuf = lBuf+1
183     msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
184     lBuf = lBuf+IL-1
185     mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
186     nvname = nvname + IL
187     ENDIF
188 edhill 1.8 ENDIF
189 cnh 1.1
190 edhill 1.16 C write(*,*) 'mon_vname = ''', mon_vname(1:nvname), ''''
191     C write(*,*) 'mon_write_mnc = ''', mon_write_mnc, ''''
192     C write(*,*) 'mon_write_stdout = ''', mon_write_stdout, ''''
193 jmc 1.17
194 edhill 1.16 msgBuf(35:35) = '='
195 jmc 1.17
196 edhill 1.16 IF (mon_write_stdout) THEN
197     IF (itype .EQ. 1)
198     & WRITE(msgBuf(36:57),'(1X,I21)') ival
199     IF (itype .EQ. 2)
200     & WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
201     C & WRITE(msgBuf(35:57),'(1X,1P1E22.13E3)') dval
202 jmc 1.17
203 edhill 1.16 C Note that the above call fixes problems where there is
204     C insufficient space in the output format to handle variables
205     C such as 1.234500000E107 which, although they are wildly large,
206     C they may actually happen in some situations. But, changing
207     C the monitor output format also means changing the routines
208     C that parse the monitor output for testreport.
209 edhill 1.8
210 edhill 1.16 CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
211     ENDIF
212 jmc 1.17
213 edhill 1.8 #ifdef ALLOW_MNC
214 edhill 1.16 IF (useMNC .AND. mon_write_mnc) THEN
215     CALL MNC_CW_APPEND_VNAME(
216     & mon_vname, '-_-_--__-__t', 0,0, myThid)
217     IF (itype .EQ. 1)
218     & CALL MNC_CW_I_W(
219     & 'I',mon_fname,1,1,mon_vname, ivarr, myThid)
220     IF (itype .EQ. 2)
221     & CALL MNC_CW_RL_W(
222     & 'D',mon_fname,1,1,mon_vname, dvarr, myThid)
223     ENDIF
224 edhill 1.8 #endif /* ALLOW_MNC */
225    
226 jmc 1.17 C-- endif master cpu io
227 edhill 1.16 ENDIF
228 cnh 1.1
229     RETURN
230     END
231 edhill 1.6
232     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  ViewVC Help
Powered by ViewVC 1.1.22