/[MITgcm]/MITgcm/pkg/ecco/ecco_check_exp.F
ViewVC logotype

Contents of /MITgcm/pkg/ecco/ecco_check_exp.F

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


Revision 1.1 - (show annotations) (download)
Fri Jul 13 13:42:16 2001 UTC (22 years, 10 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint40pre2, checkpoint40pre3
o Added probing routine
o Added runtime flag for useGrdchk

1 #include "CPP_OPTIONS.h"
2
3 subroutine ecco_check_exp(
4 & mythid, mycurrentiter, mycurrenttime, yprefix )
5
6 c =================================================================
7 c SUBROUTINE ecco_check_exp
8 c =================================================================
9 c
10 c o Check details of the model run
11 c
12 c This routine dumps a collection of model fields for diagnostic
13 c or testimg purposes, respectively.
14 c
15 c Variables for experiment 06:
16 c
17 c Dynamical core:
18 c Potential temperature theta [C]
19 c Salinity salt [psu]
20 c Zonal velocity uvel [m/s]
21 c Meridional velocity vvel [m/s]
22 c Vertical velocity ( --> check_fld) rvel [m/s]
23 c Surface pressure cg2d_x [m]
24 c Surface heat flux qnet [K/s]
25 c Qnet contrib. from external forcing tflux [K/s]
26 c Qnet contrib. from relaxation to Levitus qlev [K/s]
27 c Qnet contrib. from relaxation to Reynolds qrey [K/s]
28 c Surface virtual salt flux empmr [psu/s]
29 c Surface zonal wind stress fu [m/s^2]
30 c Surface meridional wind stress fv [m/s^2]
31 c
32 c Control vector contributions:
33 c Heat flux correction xx_hflux [W/m^2]
34 c Virtual salt flux correction xx_sflux [psu/s/m^2]
35 c Zonal wind stress correction xx_tauu [N/m^2]
36 c Meridional wind stress correction xx_tauv [N/m^2]
37 c
38 c Bulk formulae:
39 c Atmospheric zonal wind uwind [m/s]
40 c Atmospheric meridional wind vwind [m/s]
41 c Air temperature atemp [K]
42 c Specific humidity aqh [kg/kg]
43 c Precipitation precip [kg/s/m^2]
44 c Short wave radiative flux swflux/qsw [W/m^2]
45 c Long wave radiative flux lwflux/qlw [W/m^2]
46 c
47 c Non-local K-Profile Parameterization (KPP):
48 c Short wave radiative flux swflux/qsw [W/m^2]
49 c Boundary layer depth kpphbl [m]
50 c
51 c
52 c Beta Version: Christian Eckert (MIT) 15-Nov-1999
53 c
54 c =================================================================
55 c SUBROUTINE check_exp
56 c =================================================================
57
58 implicit none
59
60 c-- == global variables ==
61
62 cph#ifdef ALLOW_SNAPSHOTS
63
64 #include "EEPARAMS.h"
65 #include "SIZE.h"
66 #include "PARAMS.h"
67 cph#include "CG2D_EXTERNAL.h"
68 #include "DYNVARS.h"
69 #include "FFIELDS.h"
70 #include "GRID.h"
71 #include "ctrl.h"
72 cph#include "cal.h"
73 cph#include "exf_clim_param.h"
74 cph#include "exf_fields.h"
75
76 #ifdef ALLOW_KPP
77 # include "KPP_OPTIONS.h"
78 # include "KPP_PARAMS.h"
79 # include "KPP.h"
80 #endif
81
82 cph#endif
83
84 c == routine arguments ==
85 c mythid - thread number for this instance of the routine.
86
87 integer mythid
88 integer mycurrentiter
89 _RL mycurrenttime
90 character yprefix*3
91
92 cph#ifdef ALLOW_SNAPSHOTS
93
94 c-- == local variables ==
95
96 INTEGER bi,bj,i,j
97 integer irec
98 integer mydate(4)
99 character yfname*128
100
101 _RS tmpflux (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
102
103 c == end of interface ==
104
105 irec = 0
106
107 if ( mod((mycurrentiter),1) .eq. 0 ) then
108 irec = (mycurrentiter)/1 + 1
109
110 cph(
111 cph call cal_GetDate(
112 cph I mycurrentiter,
113 cph I mycurrenttime,
114 cph O mydate,
115 cph I mythid
116 cph & )
117
118 print *, 'pathei: in check_exp: iter/time/rec/yprefix ',
119 & mycurrentiter, mycurrenttime, irec, ' ', yprefix
120 print *, 'pathei: in check_exp: date ', mycurrentiter
121 print *, 'pathei: in check_exp: theta ', theta(10,10,1,1,1)
122 print *, 'pathei: in check_exp: salt ', salt(10,10,1,1,1)
123 print *, 'pathei: in check_exp: uvel ', uvel(10,10,1,1,1)
124 print *, 'pathei: in check_exp: vvel ', vvel(10,10,1,1,1)
125 print *, 'pathei: in check_exp: qnet ', qnet(10,10,1,1)
126 print *, 'pathei: in check_exp: empmr ', empmr(10,10,1,1)
127 print *, 'pathei: in check_exp: fu ', fu(10,10,1,1)
128 print *, 'pathei: in check_exp: fv ', fv(10,10,1,1)
129 cph)
130
131 c-- Potential temperature:
132 write(yfname,'(128a)') ' '
133 write(yfname,'(2a)') yprefix, 'snapshot_theta'
134 call mdswritefield( yfname, 32, .false.,
135 & 'RL', nr, theta, irec,
136 & mycurrentiter, mythid )
137
138 c-- Salinity:
139 write(yfname,'(128a)') ' '
140 write(yfname,'(2a)') yprefix, 'snapshot_salt'
141 call mdswritefield( yfname, 32, .false.,
142 & 'RL', nr, salt, irec,
143 & mycurrentiter, mythid )
144
145 c-- Zonal velocity:
146 write(yfname,'(128a)') ' '
147 write(yfname,'(2a)') yprefix, 'snapshot_uvel'
148 call mdswritefield( yfname, 32, .false.,
149 & 'RL', nr, uvel, irec,
150 & mycurrentiter, mythid )
151
152 c-- Meridional velocity:
153 write(yfname,'(128a)') ' '
154 write(yfname,'(2a)') yprefix, 'snapshot_vvel'
155 call mdswritefield( yfname, 32, .false.,
156 & 'RL', nr, vvel, irec,
157 & mycurrentiter, mythid )
158
159 c-- Surface pressure:
160 cph write(yfname,'(128a)') ' '
161 cph write(yfname,'(2a)') yprefix, 'snapshot_cg2d_x'
162 cph call mdswritefield( yfname, 32, .false.,
163 cph & 'RL', 1, cg2d_x, irec,
164 cph & mycurrentiter, mythid )
165
166 c-- Surface heat flux:
167 DO bj = myByLo(myThid), myByHi(myThid)
168 DO bi = myBxLo(myThid), myBxHi(myThid)
169 DO j=1-oLy,sNy+oLy
170 DO i=1-oLx,sNx+oLx
171 tmpflux(i,j,bi,bj) =
172 & - Qnet(i,j,bi,bj)*HeatCapacity_Cp*rhoNil*dRf(1)
173 ENDDO
174 ENDDO
175 ENDDO
176 ENDDO
177 write(yfname,'(128a)') ' '
178 write(yfname,'(2a)') yprefix, 'snapshot_qnet'
179 call mdswritefield( yfname, 32, .false.,
180 & 'RS', 1, tmpflux, irec,
181 & mycurrentiter, mythid )
182
183 c-- Surface virtual salt flux:
184 DO bj = myByLo(myThid), myByHi(myThid)
185 DO bi = myBxLo(myThid), myBxHi(myThid)
186 DO j=1-oLy,sNy+oLy
187 DO i=1-oLx,sNx+oLx
188 tmpflux(i,j,bi,bj) =
189 & EmPmR(i,j,bi,bj)*dRf(1)/35.
190 ENDDO
191 ENDDO
192 ENDDO
193 ENDDO
194 write(yfname,'(128a)') ' '
195 write(yfname,'(2a)') yprefix, 'snapshot_empmr'
196 call mdswritefield( yfname, 32, .false.,
197 & 'RS', 1, tmpflux, irec,
198 & mycurrentiter, mythid )
199
200 c-- Surface zonal wind stress:
201 DO bj = myByLo(myThid), myByHi(myThid)
202 DO bi = myBxLo(myThid), myBxHi(myThid)
203 DO j=1-oLy,sNy+oLy
204 DO i=1-oLx,sNx+oLx
205 tmpflux(i,j,bi,bj) =
206 & -fu(i,j,bi,bj)*rhoNil*dRf(1)/horiVertRatio
207 ENDDO
208 ENDDO
209 ENDDO
210 ENDDO
211 write(yfname,'(128a)') ' '
212 write(yfname,'(2a)') yprefix, 'snapshot_fu'
213 call mdswritefield( yfname, 32, .false.,
214 & 'RS', 1, tmpflux, irec,
215 & mycurrentiter, mythid )
216
217 c-- Surface meridional wind stress:
218 DO bj = myByLo(myThid), myByHi(myThid)
219 DO bi = myBxLo(myThid), myBxHi(myThid)
220 DO j=1-oLy,sNy+oLy
221 DO i=1-oLx,sNx+oLx
222 tmpflux(i,j,bi,bj) =
223 & -fv(i,j,bi,bj)*rhoNil*dRf(1)/horiVertRatio
224 ENDDO
225 ENDDO
226 ENDDO
227 ENDDO
228 write(yfname,'(128a)') ' '
229 write(yfname,'(2a)') yprefix, 'snapshot_fv'
230 call mdswritefield( yfname, 32, .false.,
231 & 'RS', 1, tmpflux, irec,
232 & mycurrentiter, mythid )
233
234 c-- Control vector contributions:
235
236 c-- Heat flux (control):
237 cph call mdswritefield( yprefix//'snapshot_xx_hfl', 32, .false.,
238 cph & 'RS', 1, xx_hfl, irec,
239 cph & mycurrentiter, mythid )
240
241 c-- Virtual salt flux (control):
242 cph call mdswritefield( yprefix//'snapshot_xx_sfl', 32, .false.,
243 cph & 'RS', 1, xx_sfl, irec,
244 cph & mycurrentiter, mythid )
245
246 c-- Zonal wind stress (control):
247 cph call mdswritefield( yprefix//'snapshot_xx_tauu', 32, .false.,
248 cph & 'RS', 1, xx_tauu, irec,
249 cph & mycurrentiter, mythid )
250
251 c-- Meridional wind stress (control):
252 cph call mdswritefield( yprefix//'snapshot_xx_tauv', 32, .false.,
253 cph & 'RS', 1, xx_tauv, irec,
254 cph & mycurrentiter, mythid )
255
256 #ifdef ALLOW_BULKFORMULAE
257 c-- Atmospheric zonal wind:
258 write(yfname,'(128a)') ' '
259 write(yfname,'(2a)') yprefix, 'snapshot_uwind'
260 call mdswritefield( yfname, 32, .false.,
261 & 'RS', 1, uwind, irec,
262 & mycurrentiter, mythid )
263
264 c-- Atmospheric meridional wind:
265 write(yfname,'(128a)') ' '
266 write(yfname,'(2a)') yprefix, 'snapshot_vwind'
267 call mdswritefield( yfname, 32, .false.,
268 & 'RS', 1,vwind, irec,
269 & mycurrentiter, mythid )
270
271 c-- Air temperature:
272 write(yfname,'(128a)') ' '
273 write(yfname,'(2a)') yprefix, 'snapshot_atemp'
274 call mdswritefield( yfname, 32, .false.,
275 & 'RS', 1, atemp, irec,
276 & mycurrentiter, mythid )
277
278 c-- Relative humidity:
279 write(yfname,'(128a)') ' '
280 write(yfname,'(2a)') yprefix, 'snapshot_aqh'
281 call mdswritefield( yfname, 32, .false.,
282 & 'RS', 1, aqh, irec,
283 & mycurrentiter, mythid )
284
285 c-- Precipitation:
286 write(yfname,'(128a)') ' '
287 write(yfname,'(2a)') yprefix, 'snapshot_precip'
288 call mdswritefield( yfname, 32, .false.,
289 & 'RS', 1, precip, irec,
290 & mycurrentiter, mythid )
291
292 #ifndef ALLOW_KPP
293 c-- Short wave radiative flux:
294 write(yfname,'(128a)') ' '
295 write(yfname,'(2a)') yprefix, 'snapshot_swflux'
296 call mdswritefield( yfname, 32, .false.,
297 & 'RS', 1, swflux, irec,
298 & mycurrentiter, mythid )
299 #endif
300
301 c-- Long wave radiative flux:
302 write(yfname,'(128a)') ' '
303 write(yfname,'(2a)') yprefix, 'snapshot_lwflux'
304 call mdswritefield( yfname, 32, .false.,
305 & 'RS', 1, lwflux, irec,
306 & mycurrentiter, mythid )
307 #endif / * ALLOW_BULKFORMULAE * /
308
309 #ifdef ALLOW_KPP
310 c-- Short wave radiative flux:
311 DO bj = myByLo(myThid), myByHi(myThid)
312 DO bi = myBxLo(myThid), myBxHi(myThid)
313 DO j=1-oLy,sNy+oLy
314 DO i=1-oLx,sNx+oLx
315 tmpflux(i,j,bi,bj) =
316 & -Qsw(i,j,bi,bj)*HeatCapacity_Cp*rhoNil*dRf(1)
317 ENDDO
318 ENDDO
319 ENDDO
320 ENDDO
321 write(yfname,'(128a)') ' '
322 write(yfname,'(2a)') yprefix, 'snapshot_swflux'
323 call mdswritefield( yfname, 32, .false.,
324 & 'RS', 1, tmpflux, irec,
325 & mycurrentiter, mythid )
326
327 c-- Boundary layer depth:
328 write(yfname,'(128a)') ' '
329 write(yfname,'(2a)') yprefix, 'snapshot_kpphbl'
330 call mdswritefield( yfname, 32, .false.,
331 & 'RL', 1, kpphbl, irec,
332 & mycurrentiter, mythid )
333 #endif / * ALLOW_KPP * /
334
335 #ifdef ALLOW_CLIMSST_RELAXATION
336 c-- SST climatology:
337 write(yfname,'(128a)') ' '
338 write(yfname,'(2a)') yprefix, 'snapshot_sst'
339 call mdswritefield( yfname, 32, .false.,
340 & 'RS', 1, sst, irec,
341 & mycurrentiter, mythid )
342 #endif / * ALLOW_CLIMSST_RELAXATION * /
343
344 #ifdef ALLOW_CLIMSSS_RELAXATION
345 c-- SSS climatology:
346 write(yfname,'(128a)') ' '
347 write(yfname,'(2a)') yprefix, 'snapshot_sss'
348 call mdswritefield( yfname, 32, .false.,
349 & 'RS', 1, sss, irec,
350 & mycurrentiter, mythid )
351 #endif / * ALLOW_CLIMSSS_RELAXATION * /
352
353 endif
354
355 cph#endif / * ALLOW_SNAPSHOTS * /
356
357 return
358 end
359
360

  ViewVC Help
Powered by ViewVC 1.1.22