/[MITgcm]/MITgcm/pkg/fizhi/fizhi_wrapper.F
ViewVC logotype

Annotation of /MITgcm/pkg/fizhi/fizhi_wrapper.F

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


Revision 1.30 - (hide annotations) (download)
Thu May 18 22:14:23 2006 UTC (18 years ago) by molod
Branch: MAIN
Changes since 1.29: +34 -1 lines
Add code to fill diagnostic for SLP

1 molod 1.30 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_wrapper.F,v 1.29 2006/02/16 23:03:53 molod Exp $
2 molod 1.4 C $Name: $
3    
4 molod 1.14 #include "FIZHI_OPTIONS.h"
5 molod 1.1 subroutine fizhi_wrapper (myTime, myIter, myThid)
6     c-----------------------------------------------------------------------
7     c Subroutine fizhi_wrapper - 'Wrapper' routine to interface
8     c with physics driver.
9     c 1) Set up "bi, bj loop" and some timers and clocks.
10     c 2) Call do_fizhi - driver for physics which computes tendencies
11     c 3) Interpolate tendencies to dynamics grid in vertical
12     c 4) Convert u,v tendencies to C-Grid
13     c
14     c Calls: do_fizhi (get u,v,t,s tend, step tke, etc and tc, etc. forward)
15     c phys2dyn (4 calls - all physics tendencies)
16     c AtoC (u and v tendencies)
17     c-----------------------------------------------------------------------
18     implicit none
19     #include "SIZE.h"
20     #include "GRID.h"
21 molod 1.8 #include "EEPARAMS.h"
22 molod 1.28 #include "PARAMS.h"
23 molod 1.8 #include "SURFACE.h"
24     #include "DYNVARS.h"
25 molod 1.6 #include "fizhi_land_SIZE.h"
26 molod 1.1 #include "fizhi_SIZE.h"
27     #include "fizhi_coms.h"
28     #include "gridalt_mapping.h"
29 molod 1.9 #include "fizhi_land_coms.h"
30     #include "fizhi_earth_coms.h"
31     #include "fizhi_ocean_coms.h"
32     #include "fizhi_chemistry_coms.h"
33 molod 1.29 #ifdef ALLOW_DIAGNOSTICS
34     #include "fizhi_SHP.h"
35     #endif
36 molod 1.1
37 molod 1.25 integer myIter, myThid
38     _RL myTime
39 molod 1.28 logical diagnostics_is_on
40     external diagnostics_is_on
41 molod 1.1
42     c pe on dynamics and physics grid refers to bottom edge
43 molod 1.7 _RL pephy4fiz(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)
44 molod 1.1 _RL pephy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)
45     _RL pedyn(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr+1,nSx,nSy)
46 molod 1.7 _RL tempphy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nrphys,nSx,nSy)
47 molod 1.10 _RL fracland(sNx,sNy,Nsx,Nsy)
48 molod 1.30 _RL tempLdiag(sNx,sNy,Nrphys,Nsx,Nsy)
49     _RL tempLdiag2(sNx,sNy,Nrphys,Nsx,Nsy)
50     _RL tempdiag(sNx,sNy,Nsx,Nsy)
51 molod 1.1
52     integer i, j, L, Lbotij, bi, bj
53     integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
54 molod 1.22 _RL tempij(1-olx:sNx+olx,1-oly:sNy+oly)
55 molod 1.1
56 molod 1.8 idim1 = 1-OLx
57     idim2 = sNx+OLx
58     jdim1 = 1-OLy
59     jdim2 = sNy+OLy
60     im1 = 1
61     im2 = sNx
62     jm1 = 1
63     jm2 = sNy
64 molod 1.1
65 molod 1.29 #ifdef ALLOW_DIAGNOSTICS
66     if ( useDiagnostics ) then
67     if(diagnostics_is_on('TENDUFIZ',myThid) .or.
68     . diagnostics_is_on('CORRDU ',myThid) ) then
69     do bj = myByLo(myThid), myByHi(myThid)
70     do bi = myBxLo(myThid), myBxHi(myThid)
71     do L = 1,Nrphys
72     do j = 1,sNy
73     do i = 1,sNx
74     ubef(i,j,L,bi,bj) = uphy(i,j,L,bi,bj)
75     enddo
76     enddo
77     enddo
78     do L = 1,Nr
79     do j = 1,sNy
80     do i = 1,sNx+1
81     udynbef(i,j,L,bi,bj) = uvel(i,j,L,bi,bj)
82     enddo
83     enddo
84     enddo
85     enddo
86     enddo
87     endif
88     if(diagnostics_is_on('TENDVFIZ',myThid) .or.
89     . diagnostics_is_on('CORRDV ',myThid) ) then
90     do bj = myByLo(myThid), myByHi(myThid)
91     do bi = myBxLo(myThid), myBxHi(myThid)
92     do L = 1,Nrphys
93     do j = 1,sNy
94     do i = 1,sNx
95     vbef(i,j,L,bi,bj) = vphy(i,j,L,bi,bj)
96     enddo
97     enddo
98     enddo
99     do L = 1,Nr
100     do j = 1,sNy+1
101     do i = 1,sNx
102     vdynbef(i,j,L,bi,bj) = vvel(i,j,L,bi,bj)
103     enddo
104     enddo
105     enddo
106     enddo
107     enddo
108     endif
109     if(diagnostics_is_on('TENDTFIZ',myThid) .or.
110     . diagnostics_is_on('CORRDT ',myThid) ) then
111     do bj = myByLo(myThid), myByHi(myThid)
112     do bi = myBxLo(myThid), myBxHi(myThid)
113     do L = 1,Nrphys
114     do j = 1,sNy
115     do i = 1,sNx
116     thbef(i,j,L,bi,bj) = thphy(i,j,L,bi,bj)
117     enddo
118     enddo
119     enddo
120     do L = 1,Nr
121     do j = 1,sNy
122     do i = 1,sNx
123     thdynbef(i,j,L,bi,bj) = theta(i,j,L,bi,bj)
124     enddo
125     enddo
126     enddo
127     enddo
128     enddo
129     endif
130     if(diagnostics_is_on('TENDQFIZ',myThid) .or.
131     . diagnostics_is_on('CORRDQ ',myThid) ) then
132     do bj = myByLo(myThid), myByHi(myThid)
133     do bi = myBxLo(myThid), myBxHi(myThid)
134     do L = 1,Nrphys
135     do j = 1,sNy
136     do i = 1,sNx
137     sbef(i,j,L,bi,bj) = sphy(i,j,L,bi,bj)
138     enddo
139     enddo
140     enddo
141     do L = 1,Nr
142     do j = 1,sNy
143     do i = 1,sNx
144     sdynbef(i,j,L,bi,bj) = salt(i,j,L,bi,bj)
145     enddo
146     enddo
147     enddo
148     enddo
149     enddo
150     endif
151     endif
152     #endif
153    
154 molod 1.1 do bj = myByLo(myThid), myByHi(myThid)
155     do bi = myBxLo(myThid), myBxHi(myThid)
156    
157 molod 1.7 c Construct the physics grid pressures
158     C Note: Need one array to send to fizhi (top-down) and another
159     C For the interpolations between physics and dynamics (bottom-up)
160 molod 1.1 do j = 1,sNy
161     do i = 1,sNx
162 molod 1.11 pephy(i,j,1,bi,bj)=(Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))
163 molod 1.1 do L = 2,Nrphys+1
164     pephy(i,j,L,bi,bj)=pephy(i,j,L-1,bi,bj)-dpphys(i,j,L-1,bi,bj)
165     enddo
166     c Do not use a zero field as the top edge pressure for interpolation
167 molod 1.7 do L = 1,Nrphys+1
168     pephy4fiz(i,j,Nrphys+2-L,bi,bj)=pephy(i,j,L,bi,bj)
169     enddo
170 molod 1.1 if(pephy(i,j,Nrphys+1,bi,bj).lt.1.e-5)
171     . pephy(i,j,Nrphys+1,bi,bj) = 1.e-5
172     enddo
173     enddo
174     C Build pressures on dynamics grid
175     do j = 1,sNy
176     do i = 1,sNx
177     do L = 1,Nr
178     pedyn(i,j,L,bi,bj) = 0.
179     enddo
180     enddo
181     enddo
182     do j = 1,sNy
183 molod 1.2 do i = 1,sNx
184 molod 1.1 Lbotij = ksurfC(i,j,bi,bj)
185     if(Lbotij.ne.0.)
186 molod 1.11 . pedyn(i,j,Lbotij,bi,bj) = (Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))
187 molod 1.1 enddo
188     enddo
189     do j = 1,sNy
190     do i = 1,sNx
191     Lbotij = ksurfC(i,j,bi,bj)
192     do L = Lbotij+1,Nr+1
193     pedyn(i,j,L,bi,bj) = pedyn(i,j,L-1,bi,bj) -
194     . drF(L-1)*hfacC(i,j,L-1,bi,bj)
195     enddo
196     c Do not use a zero field as the top edge pressure for interpolation
197     if(pedyn(i,j,Nr+1,bi,bj).lt.1.e-5)
198     . pedyn(i,j,Nr+1,bi,bj) = 1.e-5
199     enddo
200     enddo
201 molod 1.3 enddo
202     enddo
203    
204 molod 1.28 #ifdef ALLOW_DIAGNOSTICS
205     if ( useDiagnostics ) then
206     if(diagnostics_is_on('FIZPRES ',myThid) ) then
207     do bj = myByLo(myThid), myByHi(myThid)
208     do bi = myBxLo(myThid), myBxHi(myThid)
209     do j = 1,sNy
210     do i = 1,sNx
211     do L = 1,Nrphys
212     tempphy(i,j,L,bi,bj) = pephy4fiz(i,j,L,bi,bj)
213     enddo
214     enddo
215     enddo
216     enddo
217     enddo
218     call diagnostics_fill(tempphy,'FIZPRES ',0,
219     . Nrphys,0,1,1,myThid)
220     endif
221     endif
222     #endif
223    
224 molod 1.3 CALL TIMER_START ('DO_FIZHI [FIZHI_WRAPPER]',mythid)
225     do bj = myByLo(myThid), myByHi(myThid)
226     do bi = myBxLo(myThid), myBxHi(myThid)
227 molod 1.10 call get_landfrac(im2,jm2,Nsx,Nsy,bi,bj,maxtyp,
228 jmc 1.27 . surftype,tilefrac,fracland(1,1,bi,bj))
229 molod 1.30
230     #ifdef ALLOW_DIAGNOSTICS
231     if ( useDiagnostics ) then
232     if(diagnostics_is_on('SLP ',myThid) ) then
233     do bj = myByLo(myThid), myByHi(myThid)
234     do bi = myBxLo(myThid), myBxHi(myThid)
235     do j = 1,sNy
236     do i = 1,sNx
237     tempdiag(i,j,L,bi,bj) = Phihydlow(i,j,bi,bj)
238     do L = 1,Nrphys+1
239     tempLdiag(i,j,L,bi,bj) = pephy4fiz(i,j,L,bi,bj)
240     tempLdiag2(i,j,L,bi,bj) = thphy(i,j,L,bi,bj)
241     enddo
242     enddo
243     enddo
244     call slprs(tempdiag,tempLdiag(1,1,1,bi,bj),
245     . tempLdiag2(1,1,1,bi,bj),fracland(1,1,bi,bj),sNx,sNy,Nrphys,slp)
246     do j = 1,sNy
247     do i = 1,sNx
248     tempij(i,j) = slp(i,j,bi,bj)
249     enddo
250     enddo
251     call diagnostics_fill(tempij,'SLP ',1,
252     . 1,2,bi,bj,myThid)
253     enddo
254     enddo
255     endif
256     endif
257     #endif
258    
259 molod 1.1 c
260     c Compute physics increments
261 molod 1.16
262 molod 1.26 call do_fizhi(myIter,myThid,
263 molod 1.16 . idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,
264     . nchp,nchptot,nchpland,
265 molod 1.24 . uphy,vphy,thphy,sphy,pephy4fiz,xC,yC,topoZ,
266 molod 1.12 . ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
267     . tgz,sst,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
268     . albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlt,chlon,
269     . tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,
270     . o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,
271 molod 1.20 . iras,nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
272     . nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
273     . imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw,fccavelw,
274 molod 1.21 . raincon,rainlsp,snowfall,
275 molod 1.12 . duphy,dvphy,dthphy,dsphy)
276 molod 1.3 enddo
277     enddo
278 molod 1.15
279 molod 1.3 CALL TIMER_STOP ('DO_FIZHI [FIZHI_WRAPPER]',mythid)
280    
281     CALL TIMER_START ('PHYS2DYN [FIZHI_WRAPPER]',mythid)
282     do bj = myByLo(myThid), myByHi(myThid)
283     do bi = myBxLo(myThid), myBxHi(myThid)
284 molod 1.1 c Interpolate (A-Grid) physics increments to dynamics grid
285 molod 1.7 C First flip the physics arrays (which are top-down)
286     C into bottom-up arrays for interpolation to dynamics grid
287     do j = 1,sNy
288     do i = 1,sNx
289     do L = 1,Nrphys
290 molod 1.12 tempphy(i,j,Nrphys+1-L,bi,bj)=duphy(i,j,L,bi,bj)
291 molod 1.7 enddo
292     enddo
293     enddo
294 molod 1.12 call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
295 molod 1.8 . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,guphy)
296 molod 1.7 do j = 1,sNy
297     do i = 1,sNx
298     do L = 1,Nrphys
299 molod 1.12 tempphy(i,j,Nrphys+1-L,bi,bj)=dvphy(i,j,L,bi,bj)
300 molod 1.7 enddo
301     enddo
302     enddo
303 molod 1.12 call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
304 molod 1.8 . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gvphy)
305 molod 1.7 do j = 1,sNy
306     do i = 1,sNx
307     do L = 1,Nrphys
308 molod 1.12 tempphy(i,j,Nrphys+1-L,bi,bj)=dthphy(i,j,L,bi,bj)
309 molod 1.7 enddo
310     enddo
311     enddo
312 molod 1.12 call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
313 molod 1.8 . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gthphy)
314 molod 1.7 do j = 1,sNy
315     do i = 1,sNx
316     do L = 1,Nrphys
317 molod 1.12 tempphy(i,j,Nrphys+1-L,bi,bj)=dsphy(i,j,L,bi,bj)
318 molod 1.7 enddo
319     enddo
320     enddo
321 molod 1.12 call phys2dyn(tempphy,pephy,idim1,idim2,jdim1,jdim2,Nrphys,
322 molod 1.8 . Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,pedyn,ksurfC,Nr,nlperdyn,gsphy)
323 molod 1.1
324     enddo
325     enddo
326 molod 1.17
327 molod 1.3 CALL TIMER_STOP ('PHYS2DYN [FIZHI_WRAPPER]',mythid)
328 molod 1.1
329     c Convert guphy and gvphy from A-grid to C-grid for use by dynamics
330 molod 1.3 CALL TIMER_START ('ATOC [FIZHI_WRAPPER]',mythid)
331 molod 1.8 call AtoC(myThid,guphy,gvphy,maskC,idim1,idim2,jdim1,jdim2,Nr,
332     . Nsx,Nsy,im1,im2,jm1,jm2,guphy,gvphy)
333 molod 1.3 CALL TIMER_STOP ('ATOC [FIZHI_WRAPPER]',mythid)
334 molod 1.2
335 molod 1.3 CALL TIMER_START ('EXCHANGES [FIZHI_WRAPPER]',mythid)
336 molod 1.2 c Call the c-grid exchange routine to fill in the halo regions (du,dv)
337     call exch_uv_xyz_RL(guphy,gvphy,.TRUE.,myThid)
338     c Call the a-grid exchange routine to fill in the halo regions (dth,ds)
339 molod 1.22 _EXCH_XYZ_R8(gthphy,myThid)
340     _EXCH_XYZ_R8(gsphy,myThid)
341 molod 1.3 CALL TIMER_STOP ('EXCHANGES [FIZHI_WRAPPER]',mythid)
342 molod 1.1
343     return
344     end

  ViewVC Help
Powered by ViewVC 1.1.22