/[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.19 - (hide 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 jmc 1.19 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_do_diags.F,v 1.18 2006/03/14 21:21:53 mlosch 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    
46 heimbach 1.2 IF (SEAICEwriteState) THEN
47    
48 edhill 1.16 IF ( DIFFERENT_MULTIPLE(SEAICE_dumpFreq,myTime,deltaTClock)
49     & ) THEN
50 heimbach 1.2
51 edhill 1.10 #ifdef ALLOW_MNC
52 edhill 1.16 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 edhill 1.17 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 edhill 1.16 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 dimitri 1.6 #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 edhill 1.16 DO bj=myByLo(myThid),myByHi(myThid)
103     DO bi=myBxLo(myThid),myBxHi(myThid)
104 mlosch 1.18 DO j=1-Oly,sNy+Oly
105     DO i=1-Olx,sNx+Olx
106 edhill 1.16 arr(i,j,bi,bj)=UICE(i,j,1,bi,bj)
107     ENDDO
108     ENDDO
109 heimbach 1.2 ENDDO
110 edhill 1.16 ENDDO
111    
112     IF (SEAICE_dump_mdsio) THEN
113 heimbach 1.2 _BARRIER
114     _BEGIN_MASTER( myThid )
115     CALL WRITE_FLD_XY_RS( 'UICE.',suff,arr,myIter,myThid)
116     _END_MASTER( myThid )
117     _BARRIER
118 edhill 1.16 ENDIF
119     #ifdef ALLOW_MNC
120     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
121 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_UICE',arr,myThid)
122 edhill 1.16 ENDIF
123     #endif
124 dimitri 1.6 #ifdef SEAICE_DEBUG
125 edhill 1.16 _EXCH_XY_R4( arr, myThid )
126     CALL PLOT_FIELD_XYRS( arr , 'Current uice ',
127     & myIter, myThid )
128 dimitri 1.6 #endif
129    
130 edhill 1.16 DO bj=myByLo(myThid),myByHi(myThid)
131     DO bi=myBxLo(myThid),myBxHi(myThid)
132 mlosch 1.18 DO j=1-Oly,sNy+Oly
133     DO i=1-Olx,sNx+Olx
134 edhill 1.16 arr(i,j,bi,bj)=VICE(i,j,1,bi,bj)
135     ENDDO
136     ENDDO
137 heimbach 1.2 ENDDO
138 edhill 1.16 ENDDO
139     IF (SEAICE_dump_mdsio) THEN
140 heimbach 1.2 _BARRIER
141     _BEGIN_MASTER( myThid )
142     CALL WRITE_FLD_XY_RS( 'VICE.',suff,arr,myIter,myThid)
143     _END_MASTER( myThid )
144     _BARRIER
145 edhill 1.16 ENDIF
146     #ifdef ALLOW_MNC
147     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
148 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_VICE',arr,myThid)
149 edhill 1.16 ENDIF
150     #endif
151 dimitri 1.6 #ifdef SEAICE_DEBUG
152 edhill 1.16 _EXCH_XY_R4( arr, myThid )
153     CALL PLOT_FIELD_XYRS( arr , 'Current vice ',
154     & myIter, myThid )
155 dimitri 1.6 #endif
156 edhill 1.16
157     DO bj=myByLo(myThid),myByHi(myThid)
158     DO bi=myBxLo(myThid),myBxHi(myThid)
159 mlosch 1.18 DO j=1-Oly,sNy+Oly
160     DO i=1-Olx,sNx+Olx
161 edhill 1.16 arr(i,j,bi,bj)=HEFF(i,j,1,bi,bj)
162     ENDDO
163     ENDDO
164 heimbach 1.2 ENDDO
165 edhill 1.16 ENDDO
166     IF (SEAICE_dump_mdsio) THEN
167 heimbach 1.2 _BARRIER
168     _BEGIN_MASTER( myThid )
169     CALL WRITE_FLD_XY_RS( 'HEFF.',suff,arr,myIter,myThid)
170     _END_MASTER( myThid )
171     _BARRIER
172 edhill 1.16 ENDIF
173     #ifdef ALLOW_MNC
174     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
175 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_HEFF',arr,myThid)
176 edhill 1.16 ENDIF
177     #endif
178 dimitri 1.6 #ifdef SEAICE_DEBUG
179 edhill 1.16 _EXCH_XY_R4( arr, myThid )
180     CALL PLOT_FIELD_XYRS( arr , 'Current heff ',
181     & myIter, myThid )
182 dimitri 1.6 #endif
183 edhill 1.16
184     DO bj=myByLo(myThid),myByHi(myThid)
185     DO bi=myBxLo(myThid),myBxHi(myThid)
186 mlosch 1.18 DO j=1-Oly,sNy+Oly
187     DO i=1-Olx,sNx+Olx
188 edhill 1.16 arr(i,j,bi,bj)=AREA(i,j,1,bi,bj)
189     ENDDO
190     ENDDO
191 heimbach 1.2 ENDDO
192 edhill 1.16 ENDDO
193     IF (SEAICE_dump_mdsio) THEN
194 heimbach 1.2 _BARRIER
195     _BEGIN_MASTER( myThid )
196     CALL WRITE_FLD_XY_RS( 'AREA.',suff,arr,myIter,myThid)
197     _END_MASTER( myThid )
198     _BARRIER
199 edhill 1.16 ENDIF
200     #ifdef ALLOW_MNC
201     IF ( useMNC .AND. SEAICE_dump_mnc ) THEN
202 edhill 1.17 CALL MNC_CW_RS_W(pf,'sice',0,0,'si_AREA',arr,myThid)
203 edhill 1.16 ENDIF
204     #endif
205 heimbach 1.2 #ifdef SEAICE_DEBUG
206 edhill 1.16 _EXCH_XY_R4( arr, myThid )
207     CALL PLOT_FIELD_XYRS( arr , 'Current area ',
208     & myIter, myThid )
209 dimitri 1.5 #endif
210 heimbach 1.2
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 dimitri 1.9 dumpFiles = .FALSE.
253     IF ( myIter .NE. nIter0 ) THEN
254 jmc 1.19 dumpFiles =
255     & DIFFERENT_MULTIPLE(SEAICE_taveFreq,myTime,deltaTClock)
256 dimitri 1.9 #ifdef ALLOW_CAL
257 jmc 1.19 IF ( useCAL ) THEN
258     CALL CAL_TIME2DUMP( SEAICE_taveFreq, deltaTClock,
259     U dumpFiles,
260     I myTime, myIter, myThid )
261     ENDIF
262 dimitri 1.9 #endif
263     ENDIF
264    
265     IF (dumpFiles) THEN
266 heimbach 1.2 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 edhill 1.10 #ifdef ALLOW_MNC
291 jmc 1.13 IF (useMNC .AND. SEAICE_tave_mnc) THEN
292 edhill 1.10 CALL MNC_CW_SET_UDIM('sice_tave', -1, myThid)
293 edhill 1.14 CALL MNC_CW_RL_W_S('D','sice_tave',0,0,'T', myTime, myThid)
294 edhill 1.10 CALL MNC_CW_SET_UDIM('sice_tave', 0, myThid)
295 edhill 1.14 CALL MNC_CW_I_W_S('I','sice_tave',0,0,'iter', myIter, myThid)
296 edhill 1.17 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 edhill 1.15 & 'si_UICEtave',UICEtave,myThid)
300 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
301 edhill 1.15 & 'si_VICEtave',VICEtave,myThid)
302 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
303 edhill 1.15 & 'si_FUtave',FUtave,myThid)
304 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
305 edhill 1.15 & 'si_FVtave',FVtave,myThid)
306 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
307 edhill 1.15 & 'si_EmPmRtave',EmPmRtave,myThid)
308 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
309 edhill 1.15 & 'si_QNETtave',QNETtave,myThid)
310 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
311 edhill 1.15 & 'si_QSWtave',QSWtave,myThid)
312 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
313 edhill 1.15 & 'si_HEFFtave',HEFFtave,myThid)
314 edhill 1.17 CALL MNC_CW_RL_W(pf,'sice_tave',0,0,
315 edhill 1.15 & 'si_AREAtave',AREAtave,myThid)
316 edhill 1.10 ENDIF
317     #endif
318 jmc 1.13 IF (SEAICE_tave_mdsio) THEN
319 edhill 1.10 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 heimbach 1.2
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 dimitri 1.3 SEAICE_TimeAve(k,bi,bj)=ZERO
349 heimbach 1.2 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