/[MITgcm]/MITgcm/pkg/seaice/seaice_do_diags.F
ViewVC logotype

Contents of /MITgcm/pkg/seaice/seaice_do_diags.F

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


Revision 1.19 - (show annotations) (download)
Mon Mar 20 15:15:39 2006 UTC (18 years, 1 month ago) by jmc
Branch: MAIN
Changes since 1.18: +8 -21 lines
move calendarDumps from "data" to "data.cal" and clean-up the code
 with a simple call to pkg/cal S/R: CAL_TIME2WRITE
 (the former piece of code started to spread over newly checked-in S/R)
add useEXF & useCAL flags (for now, set in hard-coded way)

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_do_diags.F,v 1.18 2006/03/14 21:21:53 mlosch Exp $
2 C $Name: $
3
4 #include "SEAICE_OPTIONS.h"
5
6 SUBROUTINE SEAICE_DO_DIAGS( myTime, myIter, myThid )
7 C /==========================================================\
8 C | SUBROUTINE SEAICE_DO_DIAGS |
9 C | o Do SEAICE diagnostic output. |
10 C \==========================================================/
11 IMPLICIT NONE
12
13 C === Global variables ===
14 #include "SIZE.h"
15 #include "EEPARAMS.h"
16 #include "PARAMS.h"
17 #include "FFIELDS.h"
18 #include "SEAICE_DIAGS.h"
19 #include "SEAICE_PARAMS.h"
20 #include "SEAICE_FFIELDS.h"
21 #include "SEAICE.h"
22
23 C == Routine arguments ==
24 C myTime - Current time of simulation ( s )
25 C myIter - Iteration number
26 C myThid - Number of this instance of SEAICE_DO_DIAGS
27 _RL myTime
28 INTEGER myIter
29 INTEGER myThid
30
31 C == Local variables ==
32 CHARACTER*(MAX_LEN_MBUF) suff
33 LOGICAL DIFFERENT_MULTIPLE
34 EXTERNAL DIFFERENT_MULTIPLE
35 INTEGER i, j, k, bi, bj
36 _RS arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nSx,nSy)
37 LOGICAL dumpFiles
38 CHARACTER*(1) pf
39
40 IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
41 pf(1:1) = 'D'
42 ELSE
43 pf(1:1) = 'R'
44 ENDIF
45
46 IF (SEAICEwriteState) THEN
47
48 IF ( DIFFERENT_MULTIPLE(SEAICE_dumpFreq,myTime,deltaTClock)
49 & ) THEN
50
51 #ifdef ALLOW_MNC
52 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
53 CALL MNC_CW_SET_UDIM('sice', -1, myThid)
54 CALL MNC_CW_RL_W_S('D','sice',0,0,'T', myTime, myThid)
55 CALL MNC_CW_SET_UDIM('sice', 0, myThid)
56 CALL MNC_CW_I_W_S('I','sice',0,0,'iter', myIter, myThid)
57 CALL MNC_CW_RL_W_S('D','sice',0,0,'model_time',
58 & myTime,myThid)
59 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_UWIND',uwind,myThid)
60 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_VWIND',vwind,myThid)
61 CALL MNC_CW_RS_W(pf,'sice',0,0,'fu',fu,myThid)
62 CALL MNC_CW_RS_W(pf,'sice',0,0,'fv',fv,myThid)
63 CALL MNC_CW_RS_W(pf,'sice',0,0,'EmPmR',EmPmR,myThid)
64 CALL MNC_CW_RS_W(pf,'sice',0,0,'Qnet',Qnet,myThid)
65 CALL MNC_CW_RS_W(pf,'sice',0,0,'Qsw',Qsw,myThid)
66 ENDIF
67 #endif
68 IF (SEAICE_dump_mdsio) THEN
69 WRITE(suff,'(I10.10)') myIter
70 _BARRIER
71 _BEGIN_MASTER( myThid )
72 CALL WRITE_FLD_XY_RS( 'UWIND.',suff,uwind,myIter,myThid)
73 CALL WRITE_FLD_XY_RS( 'VWIND.',suff,vwind,myIter,myThid)
74 CALL WRITE_FLD_XY_RS( 'FU.',suff,fu,myIter,myThid)
75 CALL WRITE_FLD_XY_RS( 'FV.',suff,fv,myIter,myThid)
76 CALL WRITE_FLD_XY_RS( 'EmPmR.',suff,EmPmR,myIter,myThid)
77 CALL WRITE_FLD_XY_RS( 'Qnet.',suff,Qnet,myIter,myThid)
78 CALL WRITE_FLD_XY_RS( 'Qsw.',suff,Qsw,myIter,myThid)
79 _END_MASTER( myThid )
80 _BARRIER
81 ENDIF
82
83 #ifdef SEAICE_DEBUG
84 CALL PLOT_FIELD_XYRS( uwind , 'Current uwind ', myIter, myThid )
85 CALL PLOT_FIELD_XYRS( vwind , 'Current vwind ', myIter, myThid )
86 CALL PLOT_FIELD_XYRS( atemp , 'Current atemp ', myIter, myThid )
87 CALL PLOT_FIELD_XYRS( aqh , 'Current aqh ', myIter, myThid )
88 CALL PLOT_FIELD_XYRS( lwdown, 'Current lwdown', myIter, myThid )
89 CALL PLOT_FIELD_XYRS( swdown, 'Current swdown', myIter, myThid )
90 CALL PLOT_FIELD_XYRS( precip, 'Current precip', myIter, myThid )
91 CALL PLOT_FIELD_XYRL( evap , 'Current evap ', myIter, myThid )
92 CALL PLOT_FIELD_XYRS( runoff, 'Current runoff', myIter, myThid )
93 CALL PLOT_FIELD_XYRS( SSS , 'Current SSS ', myIter, myThid )
94 CALL PLOT_FIELD_XYRS( SST , 'Current SST ', myIter, myThid )
95 CALL PLOT_FIELD_XYRL( fu , 'Current fu ', myIter, myThid )
96 CALL PLOT_FIELD_XYRL( fv , 'Current fv ', myIter, myThid )
97 CALL PLOT_FIELD_XYRL( EmPmR , 'Current EmPmR ', myIter, myThid )
98 CALL PLOT_FIELD_XYRL( Qnet , 'Current Qnet ', myIter, myThid )
99 CALL PLOT_FIELD_XYRL( Qsw , 'Current Qsw ', myIter, myThid )
100 #endif
101
102 DO bj=myByLo(myThid),myByHi(myThid)
103 DO bi=myBxLo(myThid),myBxHi(myThid)
104 DO j=1-Oly,sNy+Oly
105 DO i=1-Olx,sNx+Olx
106 arr(i,j,bi,bj)=UICE(i,j,1,bi,bj)
107 ENDDO
108 ENDDO
109 ENDDO
110 ENDDO
111
112 IF (SEAICE_dump_mdsio) THEN
113 _BARRIER
114 _BEGIN_MASTER( myThid )
115 CALL WRITE_FLD_XY_RS( 'UICE.',suff,arr,myIter,myThid)
116 _END_MASTER( myThid )
117 _BARRIER
118 ENDIF
119 #ifdef ALLOW_MNC
120 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
121 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_UICE',arr,myThid)
122 ENDIF
123 #endif
124 #ifdef SEAICE_DEBUG
125 _EXCH_XY_R4( arr, myThid )
126 CALL PLOT_FIELD_XYRS( arr , 'Current uice ',
127 & myIter, myThid )
128 #endif
129
130 DO bj=myByLo(myThid),myByHi(myThid)
131 DO bi=myBxLo(myThid),myBxHi(myThid)
132 DO j=1-Oly,sNy+Oly
133 DO i=1-Olx,sNx+Olx
134 arr(i,j,bi,bj)=VICE(i,j,1,bi,bj)
135 ENDDO
136 ENDDO
137 ENDDO
138 ENDDO
139 IF (SEAICE_dump_mdsio) THEN
140 _BARRIER
141 _BEGIN_MASTER( myThid )
142 CALL WRITE_FLD_XY_RS( 'VICE.',suff,arr,myIter,myThid)
143 _END_MASTER( myThid )
144 _BARRIER
145 ENDIF
146 #ifdef ALLOW_MNC
147 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
148 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_VICE',arr,myThid)
149 ENDIF
150 #endif
151 #ifdef SEAICE_DEBUG
152 _EXCH_XY_R4( arr, myThid )
153 CALL PLOT_FIELD_XYRS( arr , 'Current vice ',
154 & myIter, myThid )
155 #endif
156
157 DO bj=myByLo(myThid),myByHi(myThid)
158 DO bi=myBxLo(myThid),myBxHi(myThid)
159 DO j=1-Oly,sNy+Oly
160 DO i=1-Olx,sNx+Olx
161 arr(i,j,bi,bj)=HEFF(i,j,1,bi,bj)
162 ENDDO
163 ENDDO
164 ENDDO
165 ENDDO
166 IF (SEAICE_dump_mdsio) THEN
167 _BARRIER
168 _BEGIN_MASTER( myThid )
169 CALL WRITE_FLD_XY_RS( 'HEFF.',suff,arr,myIter,myThid)
170 _END_MASTER( myThid )
171 _BARRIER
172 ENDIF
173 #ifdef ALLOW_MNC
174 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
175 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_HEFF',arr,myThid)
176 ENDIF
177 #endif
178 #ifdef SEAICE_DEBUG
179 _EXCH_XY_R4( arr, myThid )
180 CALL PLOT_FIELD_XYRS( arr , 'Current heff ',
181 & myIter, myThid )
182 #endif
183
184 DO bj=myByLo(myThid),myByHi(myThid)
185 DO bi=myBxLo(myThid),myBxHi(myThid)
186 DO j=1-Oly,sNy+Oly
187 DO i=1-Olx,sNx+Olx
188 arr(i,j,bi,bj)=AREA(i,j,1,bi,bj)
189 ENDDO
190 ENDDO
191 ENDDO
192 ENDDO
193 IF (SEAICE_dump_mdsio) THEN
194 _BARRIER
195 _BEGIN_MASTER( myThid )
196 CALL WRITE_FLD_XY_RS( 'AREA.',suff,arr,myIter,myThid)
197 _END_MASTER( myThid )
198 _BARRIER
199 ENDIF
200 #ifdef ALLOW_MNC
201 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
202 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_AREA',arr,myThid)
203 ENDIF
204 #endif
205 #ifdef SEAICE_DEBUG
206 _EXCH_XY_R4( arr, myThid )
207 CALL PLOT_FIELD_XYRS( arr , 'Current area ',
208 & myIter, myThid )
209 #endif
210
211 ENDIF
212 ENDIF
213
214 C----------------------------------------------------------------
215 C Do SEAICE time averaging.
216 C----------------------------------------------------------------
217
218 #ifdef ALLOW_TIMEAVE
219
220 C-- Time-cumulations
221 DO bj = myByLo(myThid), myByHi(myThid)
222 DO bi = myBxLo(myThid), myBxHi(myThid)
223 DO j=1,sNy
224 DO i=1,sNx
225 FUtave(i,j,1,bi,bj) =
226 & FUtave(i,j,1,bi,bj) +FU(i,j,bi,bj) *deltaTclock
227 FVtave(i,j,1,bi,bj) =
228 & FVtave(i,j,1,bi,bj) +FV(i,j,bi,bj) *deltaTclock
229 EmPmRtave(i,j,1,bi,bj)=
230 & EmPmRtave(i,j,1,bi,bj)+EmPmR(i,j,bi,bj) *deltaTclock
231 QNETtave(i,j,1,bi,bj) =
232 & QNETtave(i,j,1,bi,bj) +QNET(i,j,bi,bj) *deltaTclock
233 QSWtave(i,j,1,bi,bj) =
234 & QSWtave(i,j,1,bi,bj) +QSW(i,j,bi,bj) *deltaTclock
235 UICEtave(i,j,1,bi,bj) =
236 & UICEtave(i,j,1,bi,bj) +UICE(i,j,1,bi,bj)*deltaTclock
237 VICEtave(i,j,1,bi,bj) =
238 & VICEtave(i,j,1,bi,bj) +VICE(i,j,1,bi,bj)*deltaTclock
239 HEFFtave(i,j,1,bi,bj) =
240 & HEFFtave(i,j,1,bi,bj) +HEFF(i,j,1,bi,bj)*deltaTclock
241 AREAtave(i,j,1,bi,bj) =
242 & AREAtave(i,j,1,bi,bj) +AREA(i,j,1,bi,bj)*deltaTclock
243 ENDDO
244 ENDDO
245 DO k=1,Nr
246 SEAICE_TimeAve(k,bi,bj)=SEAICE_TimeAve(k,bi,bj)+deltaTclock
247 ENDDO
248 ENDDO
249 ENDDO
250
251 C Dump files and restart average computation if needed
252 dumpFiles = .FALSE.
253 IF ( myIter .NE. nIter0 ) THEN
254 dumpFiles =
255 & DIFFERENT_MULTIPLE(SEAICE_taveFreq,myTime,deltaTClock)
256 #ifdef ALLOW_CAL
257 IF ( useCAL ) THEN
258 CALL CAL_TIME2DUMP( SEAICE_taveFreq, deltaTClock,
259 U dumpFiles,
260 I myTime, myIter, myThid )
261 ENDIF
262 #endif
263 ENDIF
264
265 IF (dumpFiles) THEN
266 C Normalize by integrated time
267 DO bj = myByLo(myThid), myByHi(myThid)
268 DO bi = myBxLo(myThid), myBxHi(myThid)
269 CALL TIMEAVE_NORMALIZ(FUtave ,SEAICE_timeave, 1,
270 & bi,bj,myThid)
271 CALL TIMEAVE_NORMALIZ(FVtave ,SEAICE_timeave, 1,
272 & bi,bj,myThid)
273 CALL TIMEAVE_NORMALIZ(EmPmRtave,SEAICE_timeave, 1,
274 & bi,bj,myThid)
275 CALL TIMEAVE_NORMALIZ(QNETtave ,SEAICE_timeave, 1,
276 & bi,bj,myThid)
277 CALL TIMEAVE_NORMALIZ(QSWtave ,SEAICE_timeave, 1,
278 & bi,bj,myThid)
279 CALL TIMEAVE_NORMALIZ(UICEtave ,SEAICE_timeave, 1,
280 & bi,bj,myThid)
281 CALL TIMEAVE_NORMALIZ(VICEtave ,SEAICE_timeave, 1,
282 & bi,bj,myThid)
283 CALL TIMEAVE_NORMALIZ(HEFFtave ,SEAICE_timeave, 1,
284 & bi,bj,myThid)
285 CALL TIMEAVE_NORMALIZ(AREAtave ,SEAICE_timeave, 1,
286 & bi,bj,myThid)
287 ENDDO
288 ENDDO
289
290 #ifdef ALLOW_MNC
291 IF (useMNC .AND. SEAICE_tave_mnc) THEN
292 CALL MNC_CW_SET_UDIM('sice_tave', -1, myThid)
293 CALL MNC_CW_RL_W_S('D','sice_tave',0,0,'T', myTime, myThid)
294 CALL MNC_CW_SET_UDIM('sice_tave', 0, myThid)
295 CALL MNC_CW_I_W_S('I','sice_tave',0,0,'iter', myIter, myThid)
296 C CALL MNC_CW_RL_W_S('D','sice_tave',0,0,'model_time',
297 C & myTime,myThid)
298 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
299 & 'si_UICEtave',UICEtave,myThid)
300 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
301 & 'si_VICEtave',VICEtave,myThid)
302 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
303 & 'si_FUtave',FUtave,myThid)
304 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
305 & 'si_FVtave',FVtave,myThid)
306 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
307 & 'si_EmPmRtave',EmPmRtave,myThid)
308 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
309 & 'si_QNETtave',QNETtave,myThid)
310 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
311 & 'si_QSWtave',QSWtave,myThid)
312 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
313 & 'si_HEFFtave',HEFFtave,myThid)
314 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
315 & 'si_AREAtave',AREAtave,myThid)
316 ENDIF
317 #endif
318 IF (SEAICE_tave_mdsio) THEN
319 WRITE(suff,'(I10.10)') myIter
320 _BARRIER
321 _BEGIN_MASTER( myThid )
322 CALL WRITE_FLD_XY_RL('FUtave.' ,suff,FUtave ,myIter,myThid)
323 CALL WRITE_FLD_XY_RL('FVtave.' ,suff,FVtave ,myIter,myThid)
324 CALL WRITE_FLD_XY_RL('EmPmRtave.',suff,EmPmRtave,myIter,myThid)
325 CALL WRITE_FLD_XY_RL('QNETtave.' ,suff,QNETtave ,myIter,myThid)
326 CALL WRITE_FLD_XY_RL('QSWtave.' ,suff,QSWtave ,myIter,myThid)
327 CALL WRITE_FLD_XY_RL('UICEtave.' ,suff,UICEtave ,myIter,myThid)
328 CALL WRITE_FLD_XY_RL('VICEtave.' ,suff,VICEtave ,myIter,myThid)
329 CALL WRITE_FLD_XY_RL('HEFFtave.' ,suff,HEFFtave ,myIter,myThid)
330 CALL WRITE_FLD_XY_RL('AREAtave.' ,suff,AREAtave ,myIter,myThid)
331 _END_MASTER( myThid )
332 _BARRIER
333 ENDIF
334
335 C Reset averages to zero
336 DO bj = myByLo(myThid), myByHi(myThid)
337 DO bi = myBxLo(myThid), myBxHi(myThid)
338 CALL TIMEAVE_RESET(FUtave ,1,bi,bj,myThid)
339 CALL TIMEAVE_RESET(FVtave ,1,bi,bj,myThid)
340 CALL TIMEAVE_RESET(EmPmRtave,1,bi,bj,myThid)
341 CALL TIMEAVE_RESET(QNETtave ,1,bi,bj,myThid)
342 CALL TIMEAVE_RESET(QSWtave ,1,bi,bj,myThid)
343 CALL TIMEAVE_RESET(UICEtave ,1,bi,bj,myThid)
344 CALL TIMEAVE_RESET(VICEtave ,1,bi,bj,myThid)
345 CALL TIMEAVE_RESET(HEFFtave ,1,bi,bj,myThid)
346 CALL TIMEAVE_RESET(AREAtave ,1,bi,bj,myThid)
347 DO k=1,Nr
348 SEAICE_TimeAve(k,bi,bj)=ZERO
349 ENDDO
350 ENDDO
351 ENDDO
352
353 ENDIF
354
355 #endif /* ALLOW_TIMEAVE */
356
357 RETURN
358 END

  ViewVC Help
Powered by ViewVC 1.1.22