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

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

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


Revision 1.2 - (hide annotations) (download)
Mon Jul 30 20:40:10 2001 UTC (22 years, 9 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint44b_post, checkpoint43a-release1mods, checkpoint44h_pre, release1_p12, release1_p10, release1_p11, release1_p16, release1_p17, release1_p15, checkpoint44f_pre, checkpoint46f_post, checkpoint41, checkpoint46d_pre, release1_p13_pre, checkpoint46e_post, release1-branch_tutorials, checkpoint46c_post, checkpoint44g_post, checkpoint46h_pre, checkpoint44h_post, release1_p12_pre, checkpoint44e_post, checkpoint46e_pre, checkpoint45d_post, checkpoint45b_post, checkpoint46b_pre, chkpt44a_pre, release1-branch-end, release1_final_v1, checkpoint46, checkpoint44, release1_p13, checkpoint44f_post, checkpoint40pre5, checkpoint40pre6, checkpoint40pre8, release1_b1, release1_p14, chkpt44d_post, checkpoint42, release1_p9, release1_p8, checkpoint46g_pre, release1_p2, release1_p3, release1_p4, release1_p6, checkpoint46a_post, chkpt44a_post, checkpoint44b_pre, release1_p1, checkpoint40pre4, checkpoint46a_pre, checkpoint45c_post, release1_p5, checkpoint44e_pre, checkpoint40pre9, release1_p7, checkpoint46b_post, checkpoint46d_post, checkpoint46g_post, checkpoint45a_post, checkpoint46c_pre, checkpoint43, release1-branch_branchpoint, release1_beta1, checkpoint40pre7, checkpoint40, checkpoint45, release1_chkpt44d_post, chkpt44c_pre, chkpt44c_post
Branch point for: ecco-branch, release1, release1_coupled, release1_final, release1-branch, release1_50yr
Changes since 1.1: +0 -1 lines
Removed ctrl header.

1 heimbach 1.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     cph#include "cal.h"
72     cph#include "exf_clim_param.h"
73     cph#include "exf_fields.h"
74    
75     #ifdef ALLOW_KPP
76     # include "KPP_OPTIONS.h"
77     # include "KPP_PARAMS.h"
78     # include "KPP.h"
79     #endif
80    
81     cph#endif
82    
83     c == routine arguments ==
84     c mythid - thread number for this instance of the routine.
85    
86     integer mythid
87     integer mycurrentiter
88     _RL mycurrenttime
89     character yprefix*3
90    
91     cph#ifdef ALLOW_SNAPSHOTS
92    
93     c-- == local variables ==
94    
95     INTEGER bi,bj,i,j
96     integer irec
97     integer mydate(4)
98     character yfname*128
99    
100     _RS tmpflux (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
101    
102     c == end of interface ==
103    
104     irec = 0
105    
106     if ( mod((mycurrentiter),1) .eq. 0 ) then
107     irec = (mycurrentiter)/1 + 1
108    
109     cph(
110     cph call cal_GetDate(
111     cph I mycurrentiter,
112     cph I mycurrenttime,
113     cph O mydate,
114     cph I mythid
115     cph & )
116    
117     print *, 'pathei: in check_exp: iter/time/rec/yprefix ',
118     & mycurrentiter, mycurrenttime, irec, ' ', yprefix
119     print *, 'pathei: in check_exp: date ', mycurrentiter
120     print *, 'pathei: in check_exp: theta ', theta(10,10,1,1,1)
121     print *, 'pathei: in check_exp: salt ', salt(10,10,1,1,1)
122     print *, 'pathei: in check_exp: uvel ', uvel(10,10,1,1,1)
123     print *, 'pathei: in check_exp: vvel ', vvel(10,10,1,1,1)
124     print *, 'pathei: in check_exp: qnet ', qnet(10,10,1,1)
125     print *, 'pathei: in check_exp: empmr ', empmr(10,10,1,1)
126     print *, 'pathei: in check_exp: fu ', fu(10,10,1,1)
127     print *, 'pathei: in check_exp: fv ', fv(10,10,1,1)
128     cph)
129    
130     c-- Potential temperature:
131     write(yfname,'(128a)') ' '
132     write(yfname,'(2a)') yprefix, 'snapshot_theta'
133     call mdswritefield( yfname, 32, .false.,
134     & 'RL', nr, theta, irec,
135     & mycurrentiter, mythid )
136    
137     c-- Salinity:
138     write(yfname,'(128a)') ' '
139     write(yfname,'(2a)') yprefix, 'snapshot_salt'
140     call mdswritefield( yfname, 32, .false.,
141     & 'RL', nr, salt, irec,
142     & mycurrentiter, mythid )
143    
144     c-- Zonal velocity:
145     write(yfname,'(128a)') ' '
146     write(yfname,'(2a)') yprefix, 'snapshot_uvel'
147     call mdswritefield( yfname, 32, .false.,
148     & 'RL', nr, uvel, irec,
149     & mycurrentiter, mythid )
150    
151     c-- Meridional velocity:
152     write(yfname,'(128a)') ' '
153     write(yfname,'(2a)') yprefix, 'snapshot_vvel'
154     call mdswritefield( yfname, 32, .false.,
155     & 'RL', nr, vvel, irec,
156     & mycurrentiter, mythid )
157    
158     c-- Surface pressure:
159     cph write(yfname,'(128a)') ' '
160     cph write(yfname,'(2a)') yprefix, 'snapshot_cg2d_x'
161     cph call mdswritefield( yfname, 32, .false.,
162     cph & 'RL', 1, cg2d_x, irec,
163     cph & mycurrentiter, mythid )
164    
165     c-- Surface heat flux:
166     DO bj = myByLo(myThid), myByHi(myThid)
167     DO bi = myBxLo(myThid), myBxHi(myThid)
168     DO j=1-oLy,sNy+oLy
169     DO i=1-oLx,sNx+oLx
170     tmpflux(i,j,bi,bj) =
171     & - Qnet(i,j,bi,bj)*HeatCapacity_Cp*rhoNil*dRf(1)
172     ENDDO
173     ENDDO
174     ENDDO
175     ENDDO
176     write(yfname,'(128a)') ' '
177     write(yfname,'(2a)') yprefix, 'snapshot_qnet'
178     call mdswritefield( yfname, 32, .false.,
179     & 'RS', 1, tmpflux, irec,
180     & mycurrentiter, mythid )
181    
182     c-- Surface virtual salt flux:
183     DO bj = myByLo(myThid), myByHi(myThid)
184     DO bi = myBxLo(myThid), myBxHi(myThid)
185     DO j=1-oLy,sNy+oLy
186     DO i=1-oLx,sNx+oLx
187     tmpflux(i,j,bi,bj) =
188     & EmPmR(i,j,bi,bj)*dRf(1)/35.
189     ENDDO
190     ENDDO
191     ENDDO
192     ENDDO
193     write(yfname,'(128a)') ' '
194     write(yfname,'(2a)') yprefix, 'snapshot_empmr'
195     call mdswritefield( yfname, 32, .false.,
196     & 'RS', 1, tmpflux, irec,
197     & mycurrentiter, mythid )
198    
199     c-- Surface zonal wind stress:
200     DO bj = myByLo(myThid), myByHi(myThid)
201     DO bi = myBxLo(myThid), myBxHi(myThid)
202     DO j=1-oLy,sNy+oLy
203     DO i=1-oLx,sNx+oLx
204     tmpflux(i,j,bi,bj) =
205     & -fu(i,j,bi,bj)*rhoNil*dRf(1)/horiVertRatio
206     ENDDO
207     ENDDO
208     ENDDO
209     ENDDO
210     write(yfname,'(128a)') ' '
211     write(yfname,'(2a)') yprefix, 'snapshot_fu'
212     call mdswritefield( yfname, 32, .false.,
213     & 'RS', 1, tmpflux, irec,
214     & mycurrentiter, mythid )
215    
216     c-- Surface meridional wind stress:
217     DO bj = myByLo(myThid), myByHi(myThid)
218     DO bi = myBxLo(myThid), myBxHi(myThid)
219     DO j=1-oLy,sNy+oLy
220     DO i=1-oLx,sNx+oLx
221     tmpflux(i,j,bi,bj) =
222     & -fv(i,j,bi,bj)*rhoNil*dRf(1)/horiVertRatio
223     ENDDO
224     ENDDO
225     ENDDO
226     ENDDO
227     write(yfname,'(128a)') ' '
228     write(yfname,'(2a)') yprefix, 'snapshot_fv'
229     call mdswritefield( yfname, 32, .false.,
230     & 'RS', 1, tmpflux, irec,
231     & mycurrentiter, mythid )
232    
233     c-- Control vector contributions:
234    
235     c-- Heat flux (control):
236     cph call mdswritefield( yprefix//'snapshot_xx_hfl', 32, .false.,
237     cph & 'RS', 1, xx_hfl, irec,
238     cph & mycurrentiter, mythid )
239    
240     c-- Virtual salt flux (control):
241     cph call mdswritefield( yprefix//'snapshot_xx_sfl', 32, .false.,
242     cph & 'RS', 1, xx_sfl, irec,
243     cph & mycurrentiter, mythid )
244    
245     c-- Zonal wind stress (control):
246     cph call mdswritefield( yprefix//'snapshot_xx_tauu', 32, .false.,
247     cph & 'RS', 1, xx_tauu, irec,
248     cph & mycurrentiter, mythid )
249    
250     c-- Meridional wind stress (control):
251     cph call mdswritefield( yprefix//'snapshot_xx_tauv', 32, .false.,
252     cph & 'RS', 1, xx_tauv, irec,
253     cph & mycurrentiter, mythid )
254    
255     #ifdef ALLOW_BULKFORMULAE
256     c-- Atmospheric zonal wind:
257     write(yfname,'(128a)') ' '
258     write(yfname,'(2a)') yprefix, 'snapshot_uwind'
259     call mdswritefield( yfname, 32, .false.,
260     & 'RS', 1, uwind, irec,
261     & mycurrentiter, mythid )
262    
263     c-- Atmospheric meridional wind:
264     write(yfname,'(128a)') ' '
265     write(yfname,'(2a)') yprefix, 'snapshot_vwind'
266     call mdswritefield( yfname, 32, .false.,
267     & 'RS', 1,vwind, irec,
268     & mycurrentiter, mythid )
269    
270     c-- Air temperature:
271     write(yfname,'(128a)') ' '
272     write(yfname,'(2a)') yprefix, 'snapshot_atemp'
273     call mdswritefield( yfname, 32, .false.,
274     & 'RS', 1, atemp, irec,
275     & mycurrentiter, mythid )
276    
277     c-- Relative humidity:
278     write(yfname,'(128a)') ' '
279     write(yfname,'(2a)') yprefix, 'snapshot_aqh'
280     call mdswritefield( yfname, 32, .false.,
281     & 'RS', 1, aqh, irec,
282     & mycurrentiter, mythid )
283    
284     c-- Precipitation:
285     write(yfname,'(128a)') ' '
286     write(yfname,'(2a)') yprefix, 'snapshot_precip'
287     call mdswritefield( yfname, 32, .false.,
288     & 'RS', 1, precip, irec,
289     & mycurrentiter, mythid )
290    
291     #ifndef ALLOW_KPP
292     c-- Short wave radiative flux:
293     write(yfname,'(128a)') ' '
294     write(yfname,'(2a)') yprefix, 'snapshot_swflux'
295     call mdswritefield( yfname, 32, .false.,
296     & 'RS', 1, swflux, irec,
297     & mycurrentiter, mythid )
298     #endif
299    
300     c-- Long wave radiative flux:
301     write(yfname,'(128a)') ' '
302     write(yfname,'(2a)') yprefix, 'snapshot_lwflux'
303     call mdswritefield( yfname, 32, .false.,
304     & 'RS', 1, lwflux, irec,
305     & mycurrentiter, mythid )
306     #endif / * ALLOW_BULKFORMULAE * /
307    
308     #ifdef ALLOW_KPP
309     c-- Short wave radiative flux:
310     DO bj = myByLo(myThid), myByHi(myThid)
311     DO bi = myBxLo(myThid), myBxHi(myThid)
312     DO j=1-oLy,sNy+oLy
313     DO i=1-oLx,sNx+oLx
314     tmpflux(i,j,bi,bj) =
315     & -Qsw(i,j,bi,bj)*HeatCapacity_Cp*rhoNil*dRf(1)
316     ENDDO
317     ENDDO
318     ENDDO
319     ENDDO
320     write(yfname,'(128a)') ' '
321     write(yfname,'(2a)') yprefix, 'snapshot_swflux'
322     call mdswritefield( yfname, 32, .false.,
323     & 'RS', 1, tmpflux, irec,
324     & mycurrentiter, mythid )
325    
326     c-- Boundary layer depth:
327     write(yfname,'(128a)') ' '
328     write(yfname,'(2a)') yprefix, 'snapshot_kpphbl'
329     call mdswritefield( yfname, 32, .false.,
330     & 'RL', 1, kpphbl, irec,
331     & mycurrentiter, mythid )
332     #endif / * ALLOW_KPP * /
333    
334     #ifdef ALLOW_CLIMSST_RELAXATION
335     c-- SST climatology:
336     write(yfname,'(128a)') ' '
337     write(yfname,'(2a)') yprefix, 'snapshot_sst'
338     call mdswritefield( yfname, 32, .false.,
339     & 'RS', 1, sst, irec,
340     & mycurrentiter, mythid )
341     #endif / * ALLOW_CLIMSST_RELAXATION * /
342    
343     #ifdef ALLOW_CLIMSSS_RELAXATION
344     c-- SSS climatology:
345     write(yfname,'(128a)') ' '
346     write(yfname,'(2a)') yprefix, 'snapshot_sss'
347     call mdswritefield( yfname, 32, .false.,
348     & 'RS', 1, sss, irec,
349     & mycurrentiter, mythid )
350     #endif / * ALLOW_CLIMSSS_RELAXATION * /
351    
352     endif
353    
354     cph#endif / * ALLOW_SNAPSHOTS * /
355    
356     return
357     end
358    
359    

  ViewVC Help
Powered by ViewVC 1.1.22