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