/[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.2 - (show annotations) (download)
Tue Nov 12 20:47:27 2002 UTC (21 years, 6 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint47, checkpoint47a_post, checkpoint46n_post
Changes since 1.1: +233 -0 lines 
Merging from release1_p8 branch:
o New package: pkg/seaice
  Sea ice model by D. Menemenlis (JPL) and Jinlun Zhang (Seattle).
  The sea-ice code is based on Hibler (1979-1980).
  Two sea-ice dynamic solvers, ADI and LSR, are included.
  In addition to computing prognostic sea-ice variables and diagnosing
  the forcing/external data fields that drive the ocean model,
  SEAICE_MODEL also sets theta to the freezing point under sea-ice.
  The implied surface heat flux is then stored in variable
  surfaceTendencyTice, which is needed by KPP package (kpp_calc.F and
  kpp_transport_t.F) to diagnose surface buoyancy fluxes and for the
  non-local transport term.  Because this call precedes model
  thermodynamics, temperature under sea-ice may not be "exactly" at
  the freezing point by the time theta is dumped or time-averaged.
1 C $Header:
2
3 #include "SEAICE_OPTIONS.h"
4
5 SUBROUTINE SEAICE_DO_DIAGS( myTime, myIter, myThid )
6 C /==========================================================\
7 C | SUBROUTINE SEAICE_DO_DIAGS |
8 C | o Do SEAICE diagnostic output. |
9 C \==========================================================/
10 IMPLICIT NONE
11
12 C === Global variables ===
13 #include "SIZE.h"
14 #include "EEPARAMS.h"
15 #include "PARAMS.h"
16 #include "FFIELDS.h"
17 #include "SEAICE_DIAGS.h"
18 #include "SEAICE_PARAMS.h"
19 #include "SEAICE_FFIELDS.h"
20 #include "SEAICE.h"
21
22 C == Routine arguments ==
23 C myTime - Current time of simulation ( s )
24 C myIter - Iteration number
25 C myThid - Number of this instance of SEAICE_DO_DIAGS
26 _RL myTime
27 INTEGER myIter
28 INTEGER myThid
29
30 #ifdef ALLOW_SEAICE
31
32 C == Local variables ==
33 CHARACTER*(MAX_LEN_MBUF) suff
34 LOGICAL DIFFERENT_MULTIPLE
35 EXTERNAL DIFFERENT_MULTIPLE
36 INTEGER i, j, k, bi, bj
37 _RS arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nSx,nSy)
38
39 IF (SEAICEwriteState) THEN
40
41 IF ( DIFFERENT_MULTIPLE(SEAICE_dumpFreq,myTime,
42 & myTime-deltaTClock) ) THEN
43
44 WRITE(suff,'(I10.10)') myIter
45 _BARRIER
46 _BEGIN_MASTER( myThid )
47 CALL WRITE_FLD_XY_RS( 'FU.',suff,fu,myIter,myThid)
48 CALL WRITE_FLD_XY_RS( 'FV.',suff,fv,myIter,myThid)
49 CALL WRITE_FLD_XY_RS( 'EmPmR.',suff,EmPmR,myIter,myThid)
50 CALL WRITE_FLD_XY_RS( 'Qnet.',suff,Qnet,myIter,myThid)
51 CALL WRITE_FLD_XY_RS( 'Qsw.',suff,Qsw,myIter,myThid)
52 _END_MASTER( myThid )
53 _BARRIER
54
55 DO bj=myByLo(myThid),myByHi(myThid)
56 DO bi=myBxLo(myThid),myBxHi(myThid)
57 DO j=1,sNy
58 DO i=1,sNx
59 arr(i,j,bi,bj)=UICE(i,j,1,bi,bj)
60 ENDDO
61 ENDDO
62 ENDDO
63 ENDDO
64 _BARRIER
65 _BEGIN_MASTER( myThid )
66 CALL WRITE_FLD_XY_RS( 'UICE.',suff,arr,myIter,myThid)
67 _END_MASTER( myThid )
68 _BARRIER
69
70 DO bj=myByLo(myThid),myByHi(myThid)
71 DO bi=myBxLo(myThid),myBxHi(myThid)
72 DO j=1,sNy
73 DO i=1,sNx
74 arr(i,j,bi,bj)=VICE(i,j,1,bi,bj)
75 ENDDO
76 ENDDO
77 ENDDO
78 ENDDO
79 _BARRIER
80 _BEGIN_MASTER( myThid )
81 CALL WRITE_FLD_XY_RS( 'VICE.',suff,arr,myIter,myThid)
82 _END_MASTER( myThid )
83 _BARRIER
84
85 DO bj=myByLo(myThid),myByHi(myThid)
86 DO bi=myBxLo(myThid),myBxHi(myThid)
87 DO j=1,sNy
88 DO i=1,sNx
89 arr(i,j,bi,bj)=HEFF(i,j,1,bi,bj)
90 ENDDO
91 ENDDO
92 ENDDO
93 ENDDO
94 _BARRIER
95 _BEGIN_MASTER( myThid )
96 CALL WRITE_FLD_XY_RS( 'HEFF.',suff,arr,myIter,myThid)
97 _END_MASTER( myThid )
98 _BARRIER
99
100 DO bj=myByLo(myThid),myByHi(myThid)
101 DO bi=myBxLo(myThid),myBxHi(myThid)
102 DO j=1,sNy
103 DO i=1,sNx
104 arr(i,j,bi,bj)=AREA(i,j,1,bi,bj)
105 ENDDO
106 ENDDO
107 ENDDO
108 ENDDO
109 _BARRIER
110 _BEGIN_MASTER( myThid )
111 CALL WRITE_FLD_XY_RS( 'AREA.',suff,arr,myIter,myThid)
112 _END_MASTER( myThid )
113 _BARRIER
114
115 #ifdef SEAICE_DEBUG
116 c CALL PLOT_FIELD_XYRS( gairx,'Current gairx ', myIter, myThid )
117 c CALL PLOT_FIELD_XYRS( gairy,'Current gairy ', myIter, myThid )
118 c CALL PLOT_FIELD_XYRS( tair ,'Current tair ' , myIter, myThid )
119 c CALL PLOT_FIELD_XYRS( qa ,'Current qa ' , myIter, myThid )
120 c CALL PLOT_FIELD_XYRS( flo ,'Current flo ' , myIter, myThid )
121 c CALL PLOT_FIELD_XYRS( fsh ,'Current fsh ' , myIter, myThid )
122 CALL PLOT_FIELD_XYRL( fu ,'Current fu ' , myIter, myThid )
123 CALL PLOT_FIELD_XYRL( fv ,'Current fv ' , myIter, myThid )
124 CALL PLOT_FIELD_XYRL( Qnet ,'Current Qnet ' , myIter, myThid )
125 #endif SEAICE_DEBUG
126
127 ENDIF
128 ENDIF
129
130 C----------------------------------------------------------------
131 C Do SEAICE time averaging.
132 C----------------------------------------------------------------
133
134 #ifdef ALLOW_TIMEAVE
135
136 C-- Time-cumulations
137 DO bj = myByLo(myThid), myByHi(myThid)
138 DO bi = myBxLo(myThid), myBxHi(myThid)
139 DO j=1,sNy
140 DO i=1,sNx
141 FUtave(i,j,1,bi,bj) =
142 & FUtave(i,j,1,bi,bj) +FU(i,j,bi,bj) *deltaTclock
143 FVtave(i,j,1,bi,bj) =
144 & FVtave(i,j,1,bi,bj) +FV(i,j,bi,bj) *deltaTclock
145 EmPmRtave(i,j,1,bi,bj)=
146 & EmPmRtave(i,j,1,bi,bj)+EmPmR(i,j,bi,bj) *deltaTclock
147 QNETtave(i,j,1,bi,bj) =
148 & QNETtave(i,j,1,bi,bj) +QNET(i,j,bi,bj) *deltaTclock
149 QSWtave(i,j,1,bi,bj) =
150 & QSWtave(i,j,1,bi,bj) +QSW(i,j,bi,bj) *deltaTclock
151 UICEtave(i,j,1,bi,bj) =
152 & UICEtave(i,j,1,bi,bj) +UICE(i,j,1,bi,bj)*deltaTclock
153 VICEtave(i,j,1,bi,bj) =
154 & VICEtave(i,j,1,bi,bj) +VICE(i,j,1,bi,bj)*deltaTclock
155 HEFFtave(i,j,1,bi,bj) =
156 & HEFFtave(i,j,1,bi,bj) +HEFF(i,j,1,bi,bj)*deltaTclock
157 AREAtave(i,j,1,bi,bj) =
158 & AREAtave(i,j,1,bi,bj) +AREA(i,j,1,bi,bj)*deltaTclock
159 ENDDO
160 ENDDO
161 DO k=1,Nr
162 SEAICE_TimeAve(k,bi,bj)=SEAICE_TimeAve(k,bi,bj)+deltaTclock
163 ENDDO
164 ENDDO
165 ENDDO
166
167 C Dump files and restart average computation if needed
168 IF ( myIter.NE.nIter0 .AND.
169 & DIFFERENT_MULTIPLE(SEAICE_taveFreq,myTime,myTime-deltaTClock)
170 & ) THEN
171
172 C Normalize by integrated time
173 DO bj = myByLo(myThid), myByHi(myThid)
174 DO bi = myBxLo(myThid), myBxHi(myThid)
175 CALL TIMEAVE_NORMALIZ(FUtave ,SEAICE_timeave, 1,
176 & bi,bj,myThid)
177 CALL TIMEAVE_NORMALIZ(FVtave ,SEAICE_timeave, 1,
178 & bi,bj,myThid)
179 CALL TIMEAVE_NORMALIZ(EmPmRtave,SEAICE_timeave, 1,
180 & bi,bj,myThid)
181 CALL TIMEAVE_NORMALIZ(QNETtave ,SEAICE_timeave, 1,
182 & bi,bj,myThid)
183 CALL TIMEAVE_NORMALIZ(QSWtave ,SEAICE_timeave, 1,
184 & bi,bj,myThid)
185 CALL TIMEAVE_NORMALIZ(UICEtave ,SEAICE_timeave, 1,
186 & bi,bj,myThid)
187 CALL TIMEAVE_NORMALIZ(VICEtave ,SEAICE_timeave, 1,
188 & bi,bj,myThid)
189 CALL TIMEAVE_NORMALIZ(HEFFtave ,SEAICE_timeave, 1,
190 & bi,bj,myThid)
191 CALL TIMEAVE_NORMALIZ(AREAtave ,SEAICE_timeave, 1,
192 & bi,bj,myThid)
193 ENDDO
194 ENDDO
195
196 WRITE(suff,'(I10.10)') myIter
197
198 CALL WRITE_FLD_XY_RL('FUtave.' ,suff,FUtave ,myIter,myThid)
199 CALL WRITE_FLD_XY_RL('FVtave.' ,suff,FVtave ,myIter,myThid)
200 CALL WRITE_FLD_XY_RL('EmPmRtave.',suff,EmPmRtave,myIter,myThid)
201 CALL WRITE_FLD_XY_RL('QNETtave.' ,suff,QNETtave ,myIter,myThid)
202 CALL WRITE_FLD_XY_RL('QSWtave.' ,suff,QSWtave ,myIter,myThid)
203 CALL WRITE_FLD_XY_RL('UICEtave.' ,suff,UICEtave ,myIter,myThid)
204 CALL WRITE_FLD_XY_RL('VICEtave.' ,suff,VICEtave ,myIter,myThid)
205 CALL WRITE_FLD_XY_RL('HEFFtave.' ,suff,HEFFtave ,myIter,myThid)
206 CALL WRITE_FLD_XY_RL('AREAtave.' ,suff,AREAtave ,myIter,myThid)
207
208 C Reset averages to zero
209 DO bj = myByLo(myThid), myByHi(myThid)
210 DO bi = myBxLo(myThid), myBxHi(myThid)
211 CALL TIMEAVE_RESET(FUtave ,1,bi,bj,myThid)
212 CALL TIMEAVE_RESET(FVtave ,1,bi,bj,myThid)
213 CALL TIMEAVE_RESET(EmPmRtave,1,bi,bj,myThid)
214 CALL TIMEAVE_RESET(QNETtave ,1,bi,bj,myThid)
215 CALL TIMEAVE_RESET(QSWtave ,1,bi,bj,myThid)
216 CALL TIMEAVE_RESET(UICEtave ,1,bi,bj,myThid)
217 CALL TIMEAVE_RESET(VICEtave ,1,bi,bj,myThid)
218 CALL TIMEAVE_RESET(HEFFtave ,1,bi,bj,myThid)
219 CALL TIMEAVE_RESET(AREAtave ,1,bi,bj,myThid)
220 DO k=1,Nr
221 SEAICE_TimeAve(k,bi,bj)=0.
222 ENDDO
223 ENDDO
224 ENDDO
225
226 ENDIF
227
228 #endif /* ALLOW_TIMEAVE */
229
230 #endif ALLOW_SEAICE
231
232 RETURN
233 END
  ViewVC Help
Powered by ViewVC 1.1.22