/[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.18 - (show annotations) (download)
Tue Mar 14 21:21:53 2006 UTC (18 years, 1 month ago) by mlosch
Branch: MAIN
Changes since 1.17: +9 -9 lines
copy the halos to the array that ends up in the mnc or mdsio file in
order to avoid funny values in the files (it cost me two hours to
figure out what that was, while I was looking for bugs in the exchanges!)

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_do_diags.F,v 1.17 2005/09/29 12:19:52 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-Oly,sNy+Oly
106 DO i=1-Olx,sNx+Olx
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-Oly,sNy+Oly
134 DO i=1-Olx,sNx+Olx
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-Oly,sNy+Oly
161 DO i=1-Olx,sNx+Olx
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-Oly,sNy+Oly
188 DO i=1-Olx,sNx+Olx
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