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

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

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


Revision 1.22 - (hide annotations) (download)
Wed Aug 9 04:33:25 2006 UTC (17 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58n_post
Changes since 1.21: +25 -38 lines
all threads call WRITE_FLD S/R (needed if using SingleCpuIO)
 (no BEGIN_MASTER/ END_MASTER around the call, but inside MDSIO S/R)

1 jmc 1.22 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_do_diags.F,v 1.21 2006/06/20 20:57:06 jmc Exp $
2 edhill 1.7 C $Name: $
3 heimbach 1.2
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 jmc 1.12 LOGICAL DIFFERENT_MULTIPLE
34     EXTERNAL DIFFERENT_MULTIPLE
35 heimbach 1.2 INTEGER i, j, k, bi, bj
36     _RS arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nSx,nSy)
37 dimitri 1.9 LOGICAL dumpFiles
38 edhill 1.17 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 jmc 1.21
46 heimbach 1.2 IF (SEAICEwriteState) THEN
47    
48 edhill 1.16 IF ( DIFFERENT_MULTIPLE(SEAICE_dumpFreq,myTime,deltaTClock)
49     & ) THEN
50 jmc 1.22
51     _BARRIER
52 edhill 1.10 #ifdef ALLOW_MNC
53 edhill 1.16 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 mlosch 1.20 #if ( defined(SEAICE_CGRID) && defined(SEAICE_ALLOW_EVP) )
61     IF ( SEAICEuseEVP ) THEN
62     CALL MNC_CW_RS_W(pf,'sice',0,0,'si_sigma1',
63     & seaice_sigma1,myThid)
64     CALL MNC_CW_RS_W(pf,'sice',0,0,'si_sigma2',
65     & seaice_sigma2,myThid)
66     CALL MNC_CW_RS_W(pf,'sice',0,0,'si_sigma12',
67     & seaice_sigma12,myThid)
68     ENDIF
69     #endif /* SEAICE_CGRID and SEAICE_ALLOW_EVP */
70 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_UWIND',uwind,myThid)
71     CALL MNC_CW_RS_W(pf,'sice',0,0,'si_VWIND',vwind,myThid)
72     CALL MNC_CW_RS_W(pf,'sice',0,0,'fu',fu,myThid)
73     CALL MNC_CW_RS_W(pf,'sice',0,0,'fv',fv,myThid)
74     CALL MNC_CW_RS_W(pf,'sice',0,0,'EmPmR',EmPmR,myThid)
75     CALL MNC_CW_RS_W(pf,'sice',0,0,'Qnet',Qnet,myThid)
76     CALL MNC_CW_RS_W(pf,'sice',0,0,'Qsw',Qsw,myThid)
77 edhill 1.16 ENDIF
78     #endif
79     IF (SEAICE_dump_mdsio) THEN
80     WRITE(suff,'(I10.10)') myIter
81     CALL WRITE_FLD_XY_RS( 'UWIND.',suff,uwind,myIter,myThid)
82     CALL WRITE_FLD_XY_RS( 'VWIND.',suff,vwind,myIter,myThid)
83     CALL WRITE_FLD_XY_RS( 'FU.',suff,fu,myIter,myThid)
84     CALL WRITE_FLD_XY_RS( 'FV.',suff,fv,myIter,myThid)
85     CALL WRITE_FLD_XY_RS( 'EmPmR.',suff,EmPmR,myIter,myThid)
86     CALL WRITE_FLD_XY_RS( 'Qnet.',suff,Qnet,myIter,myThid)
87     CALL WRITE_FLD_XY_RS( 'Qsw.',suff,Qsw,myIter,myThid)
88 mlosch 1.20 #if ( defined(SEAICE_CGRID) && defined(SEAICE_ALLOW_EVP) )
89     IF ( SEAICEuseEVP ) THEN
90 jmc 1.22 CALL WRITE_FLD_XY_RS('SIGMA1.',suff,seaice_sigma1,
91 mlosch 1.20 & myIter,myThid)
92 jmc 1.22 CALL WRITE_FLD_XY_RS('SIGMA2.',suff,seaice_sigma2,
93 mlosch 1.20 & myIter,myThid)
94 jmc 1.22 CALL WRITE_FLD_XY_RS('SIGMA12.',suff,seaice_sigma12,
95 mlosch 1.20 & myIter,myThid)
96     ENDIF
97     #endif /* SEAICE_CGRID and SEAICE_ALLOW_EVP */
98 edhill 1.16 ENDIF
99 jmc 1.22
100 dimitri 1.6 #ifdef SEAICE_DEBUG
101     CALL PLOT_FIELD_XYRS( uwind , 'Current uwind ', myIter, myThid )
102     CALL PLOT_FIELD_XYRS( vwind , 'Current vwind ', myIter, myThid )
103     CALL PLOT_FIELD_XYRS( atemp , 'Current atemp ', myIter, myThid )
104     CALL PLOT_FIELD_XYRS( aqh , 'Current aqh ', myIter, myThid )
105     CALL PLOT_FIELD_XYRS( lwdown, 'Current lwdown', myIter, myThid )
106     CALL PLOT_FIELD_XYRS( swdown, 'Current swdown', myIter, myThid )
107     CALL PLOT_FIELD_XYRS( precip, 'Current precip', myIter, myThid )
108     CALL PLOT_FIELD_XYRL( evap , 'Current evap ', myIter, myThid )
109     CALL PLOT_FIELD_XYRS( runoff, 'Current runoff', myIter, myThid )
110     CALL PLOT_FIELD_XYRS( SSS , 'Current SSS ', myIter, myThid )
111     CALL PLOT_FIELD_XYRS( SST , 'Current SST ', myIter, myThid )
112     CALL PLOT_FIELD_XYRL( fu , 'Current fu ', myIter, myThid )
113     CALL PLOT_FIELD_XYRL( fv , 'Current fv ', myIter, myThid )
114     CALL PLOT_FIELD_XYRL( EmPmR , 'Current EmPmR ', myIter, myThid )
115     CALL PLOT_FIELD_XYRL( Qnet , 'Current Qnet ', myIter, myThid )
116     CALL PLOT_FIELD_XYRL( Qsw , 'Current Qsw ', myIter, myThid )
117     #endif
118    
119 edhill 1.16 DO bj=myByLo(myThid),myByHi(myThid)
120     DO bi=myBxLo(myThid),myBxHi(myThid)
121 mlosch 1.18 DO j=1-Oly,sNy+Oly
122     DO i=1-Olx,sNx+Olx
123 edhill 1.16 arr(i,j,bi,bj)=UICE(i,j,1,bi,bj)
124     ENDDO
125     ENDDO
126 heimbach 1.2 ENDDO
127 edhill 1.16 ENDDO
128 jmc 1.22 _BARRIER
129 edhill 1.16 IF (SEAICE_dump_mdsio) THEN
130 heimbach 1.2 CALL WRITE_FLD_XY_RS( 'UICE.',suff,arr,myIter,myThid)
131 edhill 1.16 ENDIF
132     #ifdef ALLOW_MNC
133     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
134 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_UICE',arr,myThid)
135 edhill 1.16 ENDIF
136     #endif
137 dimitri 1.6 #ifdef SEAICE_DEBUG
138 edhill 1.16 _EXCH_XY_R4( arr, myThid )
139 jmc 1.22 CALL PLOT_FIELD_XYRS( arr , 'Current uice ',
140 edhill 1.16 & myIter, myThid )
141 dimitri 1.6 #endif
142 jmc 1.22 _BARRIER
143 dimitri 1.6
144 edhill 1.16 DO bj=myByLo(myThid),myByHi(myThid)
145     DO bi=myBxLo(myThid),myBxHi(myThid)
146 mlosch 1.18 DO j=1-Oly,sNy+Oly
147     DO i=1-Olx,sNx+Olx
148 edhill 1.16 arr(i,j,bi,bj)=VICE(i,j,1,bi,bj)
149     ENDDO
150     ENDDO
151 heimbach 1.2 ENDDO
152 edhill 1.16 ENDDO
153 jmc 1.22 _BARRIER
154 edhill 1.16 IF (SEAICE_dump_mdsio) THEN
155 heimbach 1.2 CALL WRITE_FLD_XY_RS( 'VICE.',suff,arr,myIter,myThid)
156 edhill 1.16 ENDIF
157     #ifdef ALLOW_MNC
158     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
159 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_VICE',arr,myThid)
160 edhill 1.16 ENDIF
161     #endif
162 dimitri 1.6 #ifdef SEAICE_DEBUG
163 edhill 1.16 _EXCH_XY_R4( arr, myThid )
164 jmc 1.22 CALL PLOT_FIELD_XYRS( arr , 'Current vice ',
165 edhill 1.16 & myIter, myThid )
166 dimitri 1.6 #endif
167 jmc 1.22 _BARRIER
168    
169 edhill 1.16 DO bj=myByLo(myThid),myByHi(myThid)
170     DO bi=myBxLo(myThid),myBxHi(myThid)
171 mlosch 1.18 DO j=1-Oly,sNy+Oly
172     DO i=1-Olx,sNx+Olx
173 edhill 1.16 arr(i,j,bi,bj)=HEFF(i,j,1,bi,bj)
174     ENDDO
175     ENDDO
176 heimbach 1.2 ENDDO
177 edhill 1.16 ENDDO
178 jmc 1.22 _BARRIER
179 edhill 1.16 IF (SEAICE_dump_mdsio) THEN
180 heimbach 1.2 CALL WRITE_FLD_XY_RS( 'HEFF.',suff,arr,myIter,myThid)
181 edhill 1.16 ENDIF
182     #ifdef ALLOW_MNC
183     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
184 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_HEFF',arr,myThid)
185 edhill 1.16 ENDIF
186     #endif
187 dimitri 1.6 #ifdef SEAICE_DEBUG
188 edhill 1.16 _EXCH_XY_R4( arr, myThid )
189     CALL PLOT_FIELD_XYRS( arr , 'Current heff ',
190     & myIter, myThid )
191 dimitri 1.6 #endif
192 jmc 1.22 _BARRIER
193    
194 edhill 1.16 DO bj=myByLo(myThid),myByHi(myThid)
195     DO bi=myBxLo(myThid),myBxHi(myThid)
196 mlosch 1.18 DO j=1-Oly,sNy+Oly
197     DO i=1-Olx,sNx+Olx
198 edhill 1.16 arr(i,j,bi,bj)=AREA(i,j,1,bi,bj)
199     ENDDO
200     ENDDO
201 heimbach 1.2 ENDDO
202 edhill 1.16 ENDDO
203 jmc 1.22 _BARRIER
204 edhill 1.16 IF (SEAICE_dump_mdsio) THEN
205 heimbach 1.2 CALL WRITE_FLD_XY_RS( 'AREA.',suff,arr,myIter,myThid)
206 edhill 1.16 ENDIF
207     #ifdef ALLOW_MNC
208     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
209 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_AREA',arr,myThid)
210 edhill 1.16 ENDIF
211     #endif
212 heimbach 1.2 #ifdef SEAICE_DEBUG
213 edhill 1.16 _EXCH_XY_R4( arr, myThid )
214     CALL PLOT_FIELD_XYRS( arr , 'Current area ',
215     & myIter, myThid )
216 dimitri 1.5 #endif
217 jmc 1.22 _BARRIER
218 heimbach 1.2
219     ENDIF
220     ENDIF
221    
222     C----------------------------------------------------------------
223     C Do SEAICE time averaging.
224     C----------------------------------------------------------------
225    
226     #ifdef ALLOW_TIMEAVE
227    
228     C-- Time-cumulations
229     DO bj = myByLo(myThid), myByHi(myThid)
230     DO bi = myBxLo(myThid), myBxHi(myThid)
231     DO j=1,sNy
232     DO i=1,sNx
233     FUtave(i,j,1,bi,bj) =
234     & FUtave(i,j,1,bi,bj) +FU(i,j,bi,bj) *deltaTclock
235     FVtave(i,j,1,bi,bj) =
236     & FVtave(i,j,1,bi,bj) +FV(i,j,bi,bj) *deltaTclock
237     EmPmRtave(i,j,1,bi,bj)=
238     & EmPmRtave(i,j,1,bi,bj)+EmPmR(i,j,bi,bj) *deltaTclock
239     QNETtave(i,j,1,bi,bj) =
240     & QNETtave(i,j,1,bi,bj) +QNET(i,j,bi,bj) *deltaTclock
241     QSWtave(i,j,1,bi,bj) =
242     & QSWtave(i,j,1,bi,bj) +QSW(i,j,bi,bj) *deltaTclock
243     UICEtave(i,j,1,bi,bj) =
244     & UICEtave(i,j,1,bi,bj) +UICE(i,j,1,bi,bj)*deltaTclock
245     VICEtave(i,j,1,bi,bj) =
246     & VICEtave(i,j,1,bi,bj) +VICE(i,j,1,bi,bj)*deltaTclock
247     HEFFtave(i,j,1,bi,bj) =
248     & HEFFtave(i,j,1,bi,bj) +HEFF(i,j,1,bi,bj)*deltaTclock
249     AREAtave(i,j,1,bi,bj) =
250     & AREAtave(i,j,1,bi,bj) +AREA(i,j,1,bi,bj)*deltaTclock
251     ENDDO
252     ENDDO
253     DO k=1,Nr
254     SEAICE_TimeAve(k,bi,bj)=SEAICE_TimeAve(k,bi,bj)+deltaTclock
255     ENDDO
256     ENDDO
257     ENDDO
258    
259     C Dump files and restart average computation if needed
260 dimitri 1.9 dumpFiles = .FALSE.
261     IF ( myIter .NE. nIter0 ) THEN
262 jmc 1.19 dumpFiles =
263     & DIFFERENT_MULTIPLE(SEAICE_taveFreq,myTime,deltaTClock)
264 dimitri 1.9 #ifdef ALLOW_CAL
265 jmc 1.19 IF ( useCAL ) THEN
266     CALL CAL_TIME2DUMP( SEAICE_taveFreq, deltaTClock,
267     U dumpFiles,
268     I myTime, myIter, myThid )
269     ENDIF
270 dimitri 1.9 #endif
271     ENDIF
272    
273     IF (dumpFiles) THEN
274 heimbach 1.2 C Normalize by integrated time
275     DO bj = myByLo(myThid), myByHi(myThid)
276     DO bi = myBxLo(myThid), myBxHi(myThid)
277     CALL TIMEAVE_NORMALIZ(FUtave ,SEAICE_timeave, 1,
278     & bi,bj,myThid)
279     CALL TIMEAVE_NORMALIZ(FVtave ,SEAICE_timeave, 1,
280     & bi,bj,myThid)
281     CALL TIMEAVE_NORMALIZ(EmPmRtave,SEAICE_timeave, 1,
282     & bi,bj,myThid)
283     CALL TIMEAVE_NORMALIZ(QNETtave ,SEAICE_timeave, 1,
284     & bi,bj,myThid)
285     CALL TIMEAVE_NORMALIZ(QSWtave ,SEAICE_timeave, 1,
286     & bi,bj,myThid)
287     CALL TIMEAVE_NORMALIZ(UICEtave ,SEAICE_timeave, 1,
288     & bi,bj,myThid)
289     CALL TIMEAVE_NORMALIZ(VICEtave ,SEAICE_timeave, 1,
290     & bi,bj,myThid)
291     CALL TIMEAVE_NORMALIZ(HEFFtave ,SEAICE_timeave, 1,
292     & bi,bj,myThid)
293     CALL TIMEAVE_NORMALIZ(AREAtave ,SEAICE_timeave, 1,
294     & bi,bj,myThid)
295     ENDDO
296     ENDDO
297 jmc 1.22 c IF (myIter.EQ.10) WRITE(0,*) myThid, dumpFiles
298 heimbach 1.2
299 jmc 1.22 _BARRIER
300 edhill 1.10 #ifdef ALLOW_MNC
301 jmc 1.13 IF (useMNC .AND. SEAICE_tave_mnc) THEN
302 edhill 1.10 CALL MNC_CW_SET_UDIM('sice_tave', -1, myThid)
303 edhill 1.14 CALL MNC_CW_RL_W_S('D','sice_tave',0,0,'T', myTime, myThid)
304 edhill 1.10 CALL MNC_CW_SET_UDIM('sice_tave', 0, myThid)
305 edhill 1.14 CALL MNC_CW_I_W_S('I','sice_tave',0,0,'iter', myIter, myThid)
306 edhill 1.17 C CALL MNC_CW_RL_W_S('D','sice_tave',0,0,'model_time',
307     C & myTime,myThid)
308     CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
309 edhill 1.15 & 'si_UICEtave',UICEtave,myThid)
310 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
311 edhill 1.15 & 'si_VICEtave',VICEtave,myThid)
312 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
313 edhill 1.15 & 'si_FUtave',FUtave,myThid)
314 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
315 edhill 1.15 & 'si_FVtave',FVtave,myThid)
316 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
317 edhill 1.15 & 'si_EmPmRtave',EmPmRtave,myThid)
318 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
319 edhill 1.15 & 'si_QNETtave',QNETtave,myThid)
320 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
321 edhill 1.15 & 'si_QSWtave',QSWtave,myThid)
322 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
323 edhill 1.15 & 'si_HEFFtave',HEFFtave,myThid)
324 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
325 edhill 1.15 & 'si_AREAtave',AREAtave,myThid)
326 edhill 1.10 ENDIF
327     #endif
328 jmc 1.13 IF (SEAICE_tave_mdsio) THEN
329 edhill 1.10 WRITE(suff,'(I10.10)') myIter
330     CALL WRITE_FLD_XY_RL('FUtave.' ,suff,FUtave ,myIter,myThid)
331     CALL WRITE_FLD_XY_RL('FVtave.' ,suff,FVtave ,myIter,myThid)
332     CALL WRITE_FLD_XY_RL('EmPmRtave.',suff,EmPmRtave,myIter,myThid)
333     CALL WRITE_FLD_XY_RL('QNETtave.' ,suff,QNETtave ,myIter,myThid)
334     CALL WRITE_FLD_XY_RL('QSWtave.' ,suff,QSWtave ,myIter,myThid)
335     CALL WRITE_FLD_XY_RL('UICEtave.' ,suff,UICEtave ,myIter,myThid)
336     CALL WRITE_FLD_XY_RL('VICEtave.' ,suff,VICEtave ,myIter,myThid)
337     CALL WRITE_FLD_XY_RL('HEFFtave.' ,suff,HEFFtave ,myIter,myThid)
338     CALL WRITE_FLD_XY_RL('AREAtave.' ,suff,AREAtave ,myIter,myThid)
339     ENDIF
340 jmc 1.22 _BARRIER
341    
342 heimbach 1.2 C Reset averages to zero
343     DO bj = myByLo(myThid), myByHi(myThid)
344     DO bi = myBxLo(myThid), myBxHi(myThid)
345     CALL TIMEAVE_RESET(FUtave ,1,bi,bj,myThid)
346     CALL TIMEAVE_RESET(FVtave ,1,bi,bj,myThid)
347     CALL TIMEAVE_RESET(EmPmRtave,1,bi,bj,myThid)
348     CALL TIMEAVE_RESET(QNETtave ,1,bi,bj,myThid)
349     CALL TIMEAVE_RESET(QSWtave ,1,bi,bj,myThid)
350     CALL TIMEAVE_RESET(UICEtave ,1,bi,bj,myThid)
351     CALL TIMEAVE_RESET(VICEtave ,1,bi,bj,myThid)
352     CALL TIMEAVE_RESET(HEFFtave ,1,bi,bj,myThid)
353     CALL TIMEAVE_RESET(AREAtave ,1,bi,bj,myThid)
354     DO k=1,Nr
355 dimitri 1.3 SEAICE_TimeAve(k,bi,bj)=ZERO
356 heimbach 1.2 ENDDO
357     ENDDO
358     ENDDO
359 jmc 1.22
360 heimbach 1.2 ENDIF
361 jmc 1.22
362 heimbach 1.2 #endif /* ALLOW_TIMEAVE */
363    
364 jmc 1.21 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
365    
366     C-- do SEAICE monitor output : print some statistics about seaice fields
367     CALL SEAICE_MONITOR( myTime, myIter, myThid )
368    
369 heimbach 1.2 RETURN
370     END

  ViewVC Help
Powered by ViewVC 1.1.22