/[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.13 - (hide annotations) (download)
Sun May 22 02:06:07 2005 UTC (18 years, 11 months ago) by jmc
Branch: MAIN
Changes since 1.12: +5 -8 lines
Implement I/O flags as they should be. This fix several (some of them
tricky) consistency problems.

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

  ViewVC Help
Powered by ViewVC 1.1.22