/[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.17 - (show annotations) (download)
Thu Sep 29 12:19:52 2005 UTC (18 years, 7 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint57t_post, checkpoint58b_post, checkpoint57y_post, checkpoint57x_post, checkpoint57y_pre, checkpoint57v_post, checkpoint58, checkpoint57w_post, checkpint57u_post, checkpoint58a_post, checkpoint57z_post
Changes since 1.16: +31 -24 lines
 o make mnc honor the writeBinaryPrec flag for all the non-pickup and
   non-diagnostics output types

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_do_diags.F,v 1.16 2005/08/11 02:50:12 edhill 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 INTEGER thisdate(4), prevdate(4)
38 LOGICAL dumpFiles
39 CHARACTER*(1) pf
40
41 IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
42 pf(1:1) = 'D'
43 ELSE
44 pf(1:1) = 'R'
45 ENDIF
46
47 IF (SEAICEwriteState) THEN
48
49 IF ( DIFFERENT_MULTIPLE(SEAICE_dumpFreq,myTime,deltaTClock)
50 & ) THEN
51
52 #ifdef ALLOW_MNC
53 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
54 CALL MNC_CW_SET_UDIM('sice', -1, myThid)
55 CALL MNC_CW_RL_W_S('D','sice',0,0,'T', myTime, myThid)
56 CALL MNC_CW_SET_UDIM('sice', 0, myThid)
57 CALL MNC_CW_I_W_S('I','sice',0,0,'iter', myIter, myThid)
58 CALL MNC_CW_RL_W_S('D','sice',0,0,'model_time',
59 & myTime,myThid)
60 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_UWIND',uwind,myThid)
61 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_VWIND',vwind,myThid)
62 CALL MNC_CW_RS_W(pf,'sice',0,0,'fu',fu,myThid)
63 CALL MNC_CW_RS_W(pf,'sice',0,0,'fv',fv,myThid)
64 CALL MNC_CW_RS_W(pf,'sice',0,0,'EmPmR',EmPmR,myThid)
65 CALL MNC_CW_RS_W(pf,'sice',0,0,'Qnet',Qnet,myThid)
66 CALL MNC_CW_RS_W(pf,'sice',0,0,'Qsw',Qsw,myThid)
67 ENDIF
68 #endif
69 IF (SEAICE_dump_mdsio) THEN
70 WRITE(suff,'(I10.10)') myIter
71 _BARRIER
72 _BEGIN_MASTER( myThid )
73 CALL WRITE_FLD_XY_RS( 'UWIND.',suff,uwind,myIter,myThid)
74 CALL WRITE_FLD_XY_RS( 'VWIND.',suff,vwind,myIter,myThid)
75 CALL WRITE_FLD_XY_RS( 'FU.',suff,fu,myIter,myThid)
76 CALL WRITE_FLD_XY_RS( 'FV.',suff,fv,myIter,myThid)
77 CALL WRITE_FLD_XY_RS( 'EmPmR.',suff,EmPmR,myIter,myThid)
78 CALL WRITE_FLD_XY_RS( 'Qnet.',suff,Qnet,myIter,myThid)
79 CALL WRITE_FLD_XY_RS( 'Qsw.',suff,Qsw,myIter,myThid)
80 _END_MASTER( myThid )
81 _BARRIER
82 ENDIF
83
84 #ifdef SEAICE_DEBUG
85 CALL PLOT_FIELD_XYRS( uwind , 'Current uwind ', myIter, myThid )
86 CALL PLOT_FIELD_XYRS( vwind , 'Current vwind ', myIter, myThid )
87 CALL PLOT_FIELD_XYRS( atemp , 'Current atemp ', myIter, myThid )
88 CALL PLOT_FIELD_XYRS( aqh , 'Current aqh ', myIter, myThid )
89 CALL PLOT_FIELD_XYRS( lwdown, 'Current lwdown', myIter, myThid )
90 CALL PLOT_FIELD_XYRS( swdown, 'Current swdown', myIter, myThid )
91 CALL PLOT_FIELD_XYRS( precip, 'Current precip', myIter, myThid )
92 CALL PLOT_FIELD_XYRL( evap , 'Current evap ', myIter, myThid )
93 CALL PLOT_FIELD_XYRS( runoff, 'Current runoff', myIter, myThid )
94 CALL PLOT_FIELD_XYRS( SSS , 'Current SSS ', myIter, myThid )
95 CALL PLOT_FIELD_XYRS( SST , 'Current SST ', myIter, myThid )
96 CALL PLOT_FIELD_XYRL( fu , 'Current fu ', myIter, myThid )
97 CALL PLOT_FIELD_XYRL( fv , 'Current fv ', myIter, myThid )
98 CALL PLOT_FIELD_XYRL( EmPmR , 'Current EmPmR ', myIter, myThid )
99 CALL PLOT_FIELD_XYRL( Qnet , 'Current Qnet ', myIter, myThid )
100 CALL PLOT_FIELD_XYRL( Qsw , 'Current Qsw ', myIter, myThid )
101 #endif
102
103 DO bj=myByLo(myThid),myByHi(myThid)
104 DO bi=myBxLo(myThid),myBxHi(myThid)
105 DO j=1,sNy
106 DO i=1,sNx
107 arr(i,j,bi,bj)=UICE(i,j,1,bi,bj)
108 ENDDO
109 ENDDO
110 ENDDO
111 ENDDO
112
113 IF (SEAICE_dump_mdsio) THEN
114 _BARRIER
115 _BEGIN_MASTER( myThid )
116 CALL WRITE_FLD_XY_RS( 'UICE.',suff,arr,myIter,myThid)
117 _END_MASTER( myThid )
118 _BARRIER
119 ENDIF
120 #ifdef ALLOW_MNC
121 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
122 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_UICE',arr,myThid)
123 ENDIF
124 #endif
125 #ifdef SEAICE_DEBUG
126 _EXCH_XY_R4( arr, myThid )
127 CALL PLOT_FIELD_XYRS( arr , 'Current uice ',
128 & myIter, myThid )
129 #endif
130
131 DO bj=myByLo(myThid),myByHi(myThid)
132 DO bi=myBxLo(myThid),myBxHi(myThid)
133 DO j=1,sNy
134 DO i=1,sNx
135 arr(i,j,bi,bj)=VICE(i,j,1,bi,bj)
136 ENDDO
137 ENDDO
138 ENDDO
139 ENDDO
140 IF (SEAICE_dump_mdsio) THEN
141 _BARRIER
142 _BEGIN_MASTER( myThid )
143 CALL WRITE_FLD_XY_RS( 'VICE.',suff,arr,myIter,myThid)
144 _END_MASTER( myThid )
145 _BARRIER
146 ENDIF
147 #ifdef ALLOW_MNC
148 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
149 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_VICE',arr,myThid)
150 ENDIF
151 #endif
152 #ifdef SEAICE_DEBUG
153 _EXCH_XY_R4( arr, myThid )
154 CALL PLOT_FIELD_XYRS( arr , 'Current vice ',
155 & myIter, myThid )
156 #endif
157
158 DO bj=myByLo(myThid),myByHi(myThid)
159 DO bi=myBxLo(myThid),myBxHi(myThid)
160 DO j=1,sNy
161 DO i=1,sNx
162 arr(i,j,bi,bj)=HEFF(i,j,1,bi,bj)
163 ENDDO
164 ENDDO
165 ENDDO
166 ENDDO
167 IF (SEAICE_dump_mdsio) THEN
168 _BARRIER
169 _BEGIN_MASTER( myThid )
170 CALL WRITE_FLD_XY_RS( 'HEFF.',suff,arr,myIter,myThid)
171 _END_MASTER( myThid )
172 _BARRIER
173 ENDIF
174 #ifdef ALLOW_MNC
175 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
176 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_HEFF',arr,myThid)
177 ENDIF
178 #endif
179 #ifdef SEAICE_DEBUG
180 _EXCH_XY_R4( arr, myThid )
181 CALL PLOT_FIELD_XYRS( arr , 'Current heff ',
182 & myIter, myThid )
183 #endif
184
185 DO bj=myByLo(myThid),myByHi(myThid)
186 DO bi=myBxLo(myThid),myBxHi(myThid)
187 DO j=1,sNy
188 DO i=1,sNx
189 arr(i,j,bi,bj)=AREA(i,j,1,bi,bj)
190 ENDDO
191 ENDDO
192 ENDDO
193 ENDDO
194 IF (SEAICE_dump_mdsio) THEN
195 _BARRIER
196 _BEGIN_MASTER( myThid )
197 CALL WRITE_FLD_XY_RS( 'AREA.',suff,arr,myIter,myThid)
198 _END_MASTER( myThid )
199 _BARRIER
200 ENDIF
201 #ifdef ALLOW_MNC
202 IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
203 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_AREA',arr,myThid)
204 ENDIF
205 #endif
206 #ifdef SEAICE_DEBUG
207 _EXCH_XY_R4( arr, myThid )
208 CALL PLOT_FIELD_XYRS( arr , 'Current area ',
209 & myIter, myThid )
210 #endif
211
212 ENDIF
213 ENDIF
214
215 C----------------------------------------------------------------
216 C Do SEAICE time averaging.
217 C----------------------------------------------------------------
218
219 #ifdef ALLOW_TIMEAVE
220
221 C-- Time-cumulations
222 DO bj = myByLo(myThid), myByHi(myThid)
223 DO bi = myBxLo(myThid), myBxHi(myThid)
224 DO j=1,sNy
225 DO i=1,sNx
226 FUtave(i,j,1,bi,bj) =
227 & FUtave(i,j,1,bi,bj) +FU(i,j,bi,bj) *deltaTclock
228 FVtave(i,j,1,bi,bj) =
229 & FVtave(i,j,1,bi,bj) +FV(i,j,bi,bj) *deltaTclock
230 EmPmRtave(i,j,1,bi,bj)=
231 & EmPmRtave(i,j,1,bi,bj)+EmPmR(i,j,bi,bj) *deltaTclock
232 QNETtave(i,j,1,bi,bj) =
233 & QNETtave(i,j,1,bi,bj) +QNET(i,j,bi,bj) *deltaTclock
234 QSWtave(i,j,1,bi,bj) =
235 & QSWtave(i,j,1,bi,bj) +QSW(i,j,bi,bj) *deltaTclock
236 UICEtave(i,j,1,bi,bj) =
237 & UICEtave(i,j,1,bi,bj) +UICE(i,j,1,bi,bj)*deltaTclock
238 VICEtave(i,j,1,bi,bj) =
239 & VICEtave(i,j,1,bi,bj) +VICE(i,j,1,bi,bj)*deltaTclock
240 HEFFtave(i,j,1,bi,bj) =
241 & HEFFtave(i,j,1,bi,bj) +HEFF(i,j,1,bi,bj)*deltaTclock
242 AREAtave(i,j,1,bi,bj) =
243 & AREAtave(i,j,1,bi,bj) +AREA(i,j,1,bi,bj)*deltaTclock
244 ENDDO
245 ENDDO
246 DO k=1,Nr
247 SEAICE_TimeAve(k,bi,bj)=SEAICE_TimeAve(k,bi,bj)+deltaTclock
248 ENDDO
249 ENDDO
250 ENDDO
251
252 C Dump files and restart average computation if needed
253 dumpFiles = .FALSE.
254 IF ( myIter .NE. nIter0 ) THEN
255 IF ( DIFFERENT_MULTIPLE(SEAICE_taveFreq,myTime,deltaTClock) )
256 & dumpFiles = .TRUE.
257 #ifdef ALLOW_CAL
258 IF ( calendarDumps .AND. (
259 & (SEAICE_taveFreq.GE. 2592000.AND.SEAICE_taveFreq.LE. 2678400).OR.
260 & (SEAICE_taveFreq.GE.31104000.AND.SEAICE_taveFreq.LE.31968000)))
261 & THEN
262 C-- Convert approximate months (30-31 days) and years (360-372 days)
263 C to exact calendar months and years.
264 C- First determine calendar dates for this and previous time step.
265 call cal_GetDate( myiter ,mytime ,thisdate,mythid )
266 call cal_GetDate( myiter-1,mytime-deltaTClock,prevdate,mythid )
267 dumpFiles = .FALSE.
268 C- Monthly SEAICE_taveFreq:
269 IF( SEAICE_taveFreq.GE. 2592000 .AND. SEAICE_taveFreq.LE. 2678400
270 & .AND. (thisdate(1)-prevdate(1)).GT.50 ) dumpFiles = .TRUE.
271 C- Yearly SEAICE_taveFreq:
272 IF( SEAICE_taveFreq.GE.31104000 .AND. SEAICE_taveFreq.LE.31968000
273 & .AND. (thisdate(1)-prevdate(1)).GT.5000 ) dumpFiles = .TRUE.
274 ENDIF
275 #endif
276 ENDIF
277
278 IF (dumpFiles) THEN
279 C Normalize by integrated time
280 DO bj = myByLo(myThid), myByHi(myThid)
281 DO bi = myBxLo(myThid), myBxHi(myThid)
282 CALL TIMEAVE_NORMALIZ(FUtave ,SEAICE_timeave, 1,
283 & bi,bj,myThid)
284 CALL TIMEAVE_NORMALIZ(FVtave ,SEAICE_timeave, 1,
285 & bi,bj,myThid)
286 CALL TIMEAVE_NORMALIZ(EmPmRtave,SEAICE_timeave, 1,
287 & bi,bj,myThid)
288 CALL TIMEAVE_NORMALIZ(QNETtave ,SEAICE_timeave, 1,
289 & bi,bj,myThid)
290 CALL TIMEAVE_NORMALIZ(QSWtave ,SEAICE_timeave, 1,
291 & bi,bj,myThid)
292 CALL TIMEAVE_NORMALIZ(UICEtave ,SEAICE_timeave, 1,
293 & bi,bj,myThid)
294 CALL TIMEAVE_NORMALIZ(VICEtave ,SEAICE_timeave, 1,
295 & bi,bj,myThid)
296 CALL TIMEAVE_NORMALIZ(HEFFtave ,SEAICE_timeave, 1,
297 & bi,bj,myThid)
298 CALL TIMEAVE_NORMALIZ(AREAtave ,SEAICE_timeave, 1,
299 & bi,bj,myThid)
300 ENDDO
301 ENDDO
302
303 #ifdef ALLOW_MNC
304 IF (useMNC .AND. SEAICE_tave_mnc) THEN
305 CALL MNC_CW_SET_UDIM('sice_tave', -1, myThid)
306 CALL MNC_CW_RL_W_S('D','sice_tave',0,0,'T', myTime, myThid)
307 CALL MNC_CW_SET_UDIM('sice_tave', 0, myThid)
308 CALL MNC_CW_I_W_S('I','sice_tave',0,0,'iter', myIter, myThid)
309 C CALL MNC_CW_RL_W_S('D','sice_tave',0,0,'model_time',
310 C & myTime,myThid)
311 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
312 & 'si_UICEtave',UICEtave,myThid)
313 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
314 & 'si_VICEtave',VICEtave,myThid)
315 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
316 & 'si_FUtave',FUtave,myThid)
317 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
318 & 'si_FVtave',FVtave,myThid)
319 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
320 & 'si_EmPmRtave',EmPmRtave,myThid)
321 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
322 & 'si_QNETtave',QNETtave,myThid)
323 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
324 & 'si_QSWtave',QSWtave,myThid)
325 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
326 & 'si_HEFFtave',HEFFtave,myThid)
327 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
328 & 'si_AREAtave',AREAtave,myThid)
329 ENDIF
330 #endif
331 IF (SEAICE_tave_mdsio) THEN
332 WRITE(suff,'(I10.10)') myIter
333 _BARRIER
334 _BEGIN_MASTER( myThid )
335 CALL WRITE_FLD_XY_RL('FUtave.' ,suff,FUtave ,myIter,myThid)
336 CALL WRITE_FLD_XY_RL('FVtave.' ,suff,FVtave ,myIter,myThid)
337 CALL WRITE_FLD_XY_RL('EmPmRtave.',suff,EmPmRtave,myIter,myThid)
338 CALL WRITE_FLD_XY_RL('QNETtave.' ,suff,QNETtave ,myIter,myThid)
339 CALL WRITE_FLD_XY_RL('QSWtave.' ,suff,QSWtave ,myIter,myThid)
340 CALL WRITE_FLD_XY_RL('UICEtave.' ,suff,UICEtave ,myIter,myThid)
341 CALL WRITE_FLD_XY_RL('VICEtave.' ,suff,VICEtave ,myIter,myThid)
342 CALL WRITE_FLD_XY_RL('HEFFtave.' ,suff,HEFFtave ,myIter,myThid)
343 CALL WRITE_FLD_XY_RL('AREAtave.' ,suff,AREAtave ,myIter,myThid)
344 _END_MASTER( myThid )
345 _BARRIER
346 ENDIF
347
348 C Reset averages to zero
349 DO bj = myByLo(myThid), myByHi(myThid)
350 DO bi = myBxLo(myThid), myBxHi(myThid)
351 CALL TIMEAVE_RESET(FUtave ,1,bi,bj,myThid)
352 CALL TIMEAVE_RESET(FVtave ,1,bi,bj,myThid)
353 CALL TIMEAVE_RESET(EmPmRtave,1,bi,bj,myThid)
354 CALL TIMEAVE_RESET(QNETtave ,1,bi,bj,myThid)
355 CALL TIMEAVE_RESET(QSWtave ,1,bi,bj,myThid)
356 CALL TIMEAVE_RESET(UICEtave ,1,bi,bj,myThid)
357 CALL TIMEAVE_RESET(VICEtave ,1,bi,bj,myThid)
358 CALL TIMEAVE_RESET(HEFFtave ,1,bi,bj,myThid)
359 CALL TIMEAVE_RESET(AREAtave ,1,bi,bj,myThid)
360 DO k=1,Nr
361 SEAICE_TimeAve(k,bi,bj)=ZERO
362 ENDDO
363 ENDDO
364 ENDDO
365
366 ENDIF
367
368 #endif /* ALLOW_TIMEAVE */
369
370 RETURN
371 END

  ViewVC Help
Powered by ViewVC 1.1.22