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

Contents of /MITgcm/pkg/fizhi/fizhi_driver.F

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


Revision 1.23 - (show annotations) (download)
Thu Aug 12 15:21:22 2004 UTC (19 years, 10 months ago) by molod
Branch: MAIN
Changes since 1.22: +3 -3 lines
Debugging - Code for work-around for input vegetation dataset

1 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_driver.F,v 1.22 2004/08/10 15:13:47 molod Exp $
2 C $Name: $
3
4 #include "FIZHI_OPTIONS.h"
5 subroutine fizhi_driver (myid,im,jm,lm,bi,bj,ptracer,ntracer,
6 . xlats,xlons,
7 . p,u,v,t,q,pl,ple,dpres,pkht,pkl,fracland,landtype,radswt,
8 . phis_var,tgz,sea_ice,
9 . nchp,chlat,chlon,igrd,nchptot,nchpland,chfr,ityp,
10 . tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,capac,snodep,
11 . ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
12 . albvisdr,albvisdf,albnirdr,albnirdf,emiss,alai,agrn,
13 . chemq,chemo3,co2,cfc11,cfc12,cfc22,methane,n2o,
14 . lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq,
15 . moistu,moistv,moistt,moistq,
16 . radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg,lwgclr,
17 . st4,dst4,dlwdtg,rainlsp,raincon,snowfall,iras,nlwcld,
18 . cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,nswcld,cldtot_sw,
19 . cldras_sw,cldlsp_sw,nswlz,swlz,imstturbsw,imstturblw,qliqavesw,
20 . qliqavelw,fccavesw,fccavelw,qq)
21 C***********************************************************************
22 C Purpose
23 C -------
24 C Driver for the FIZHI high-end Atmospheric Physics
25 C
26 C Arguments Description
27 C ----------------------
28 C nymd ..... Current YYMMDD
29 C nhms ..... Current HHMMSS
30 C fracland.. Land Fractions
31 C landtype.. Land Vegetation Types
32 C radswt ... Incident Solar Radiation
33 C
34 C***********************************************************************
35 implicit none
36
37 c Diagnostic Common
38 c -----------------
39 #ifdef ALLOW_DIAGNOSTICS
40 #include "SIZE.h"
41 #include "diagnostics_SIZE.h"
42 #include "diagnostics.h"
43 #endif
44
45 c Timers Common
46 c -------------
47 #include "chronos.h"
48
49 c Input Parameters
50 c ----------------
51 integer myid,im,jm,lm,bi,bj,ptracer,ntracer
52 integer nchp,igrd(nchp),nchptot,nchpland,ityp(nchp)
53 integer iras,nlwcld,nlwlz,nswcld,nswlz
54 integer imstturbsw,imstturblw
55
56 _RL xlats(im,jm), xlons(im,jm)
57 _RL p(im,jm)
58 _RL u(im,jm,lm),v(im,jm,lm),t(im,jm,lm)
59 _RL q(im,jm,lm,ntracer)
60 _RL pl(im,jm,lm),ple(im,jm,lm+1),dpres(im,jm,lm)
61 _RL pkht(im,jm,lm)
62 _RL pkl(im,jm,lm)
63 _RL radswt(im,jm), fracland(im,jm)
64 integer landtype(im,jm)
65 _RL phis_var(im,jm), sea_ice(im,jm)
66 _RL chlat(nchp),chlon(nchp),chfr(nchp)
67 _RL tcanopy(nchp),tdeep(nchp),ecanopy(nchp),swetshal(nchp)
68 _RL swetroot(nchp),swetdeep(nchp),capac(nchp),snodep(nchp)
69 _RL ctmt(nchp),xxmt(nchp),yymt(nchp),zetamt(nchp)
70 _RL xlmt(nchp,lm),khmt(nchp,lm),tke(nchp,lm)
71 _RL co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)
72 _RL lwdt(im,jm,lm),lwdtclr(im,jm,lm)
73 _RL swdt(im,jm,lm),swdtclr(im,jm,lm)
74 _RL turbu(im,jm,lm),turbv(im,jm,lm),turbt(im,jm,lm)
75 _RL turbq(im,jm,lm)
76 _RL moistu(im,jm,lm),moistv(im,jm,lm),moistt(im,jm,lm)
77 _RL moistq(im,jm,lm)
78 _RL chemo3(im,jm,lm),chemq(im,jm,lm)
79 _RL albvisdr(im,jm),albvisdf(im,jm),albnirdr(im,jm)
80 _RL albnirdf(im,jm),emiss(im,jm,10)
81 _RL alai(nchp),agrn(nchp)
82 _RL radswg(im,jm),swgclr(im,jm)
83 _RL fdirpar(im,jm),fdifpar(im,jm),osr(im,jm),osrclr(im,jm)
84 _RL tg0(im,jm),radlwg(im,jm),lwgclr(im,jm),st4(im,jm)
85 _RL dst4(im,jm)
86 _RL dlwdtg(im,jm,lm)
87 _RL rainlsp(im,jm),raincon(im,jm),snowfall(im,jm)
88 _RL cldtot_lw(im,jm,lm),cldras_lw(im,jm,lm)
89 _RL cldlsp_lw(im,jm,lm)
90 _RL lwlz(im,jm,lm)
91 _RL cldtot_sw(im,jm,lm),cldras_sw(im,jm,lm)
92 _RL cldlsp_sw(im,jm,lm)
93 _RL swlz(im,jm,lm)
94 _RL qliqavesw(im,jm,lm),qliqavelw(im,jm,lm)
95 _RL fccavesw(im,jm,lm),fccavelw(im,jm,lm)
96 _RL qq(im,jm,lm)
97 _RL tgz(im,jm)
98
99 c Local Variables
100 c ---------------
101 logical alarm
102 external alarm
103 integer numpcheck
104 parameter (numpcheck = 5)
105 integer pchecklevs(numpcheck)
106 _RL pcheckpress(numpcheck)
107 data pcheckpress/950.,750.,700.,400.,10./
108
109 integer low_level,mid_level,nltop,nsubmin,nsubmax,Lup
110 integer ndmoist,ndturb,ndlw,ndsw
111 integer istrip,npcs
112 integer i,j,L
113 integer ndum,ndpnt
114 _RL akap,getcon
115 _RL ptop
116 logical lpnt
117
118 _RL tempij(im,jm)
119
120 istrip = im*jm
121 npcs = 1
122
123 ptop = 0.
124 akap = getcon('KAPPA')
125
126 C **********************************************************************
127 C **** Initialization ****
128 C **********************************************************************
129 call get_alarm ( 'radlw',ndum,ndum,ndlw ,ndum )
130 call get_alarm ( 'radsw',ndum,ndum,ndsw ,ndum )
131 call get_alarm ( 'turb' ,ndum,ndum,ndturb ,ndum )
132 call get_alarm ( 'moist',ndum,ndum,ndmoist,ndum )
133
134 call get_alarm ( 'pnt',ndum,ndum,ndpnt,ndum )
135 lpnt = ndpnt.ne.0
136
137 C Fill array of model levels closest to a given pressure value
138
139 call getpwhere(myid,numpcheck,pcheckpress,pchecklevs)
140
141 low_level = pchecklevs(3)
142 mid_level = pchecklevs(4)
143 nltop = pchecklevs(5)
144 nsubmin = pchecklevs(1)
145 nsubmax = pchecklevs(2)
146 Lup = pchecklevs(3)
147
148 C **********************************************************************
149 C **** Call Physics Mini-Drivers ****
150 C **********************************************************************
151
152 C SHORT WAVE RADIATION
153 C ====================
154 IF ( alarm('radsw') ) THEN
155
156 call swrio ( nymd,nhms,bi,bj,ndsw,myid,istrip,npcs,
157 . low_level,mid_level,im,jm,lm,
158 . p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
159 . albvisdr,albvisdf,albnirdr,albnirdf,swdt,swdtclr,
160 . radswg,swgclr,fdifpar,fdirpar,osr,osrclr,
161 . ptop,nswcld,cldtot_sw,cldras_sw,nswlz,swlz,
162 . .false.,imstturbsw,qliqavesw,
163 . fccavesw,landtype,xlats,xlons )
164
165 ENDIF
166
167 C LONG WAVE RADIATION
168 C ===================
169 IF ( alarm('radlw') ) THEN
170
171 c Set Reference Ground Temperature
172 c --------------------------------
173 do j=1,jm
174 do i=1,im
175 tg0(i,j) = tgz(i,j)
176 enddo
177 enddo
178
179 call lwrio ( nymd,nhms,bi,bj,istrip,npcs,
180 . low_level,mid_level,im,jm,lm,
181 . p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
182 . cfc11,cfc12,cfc22,methane,n2o,emiss,tgz,radlwg,st4,dst4,
183 . lwdt,dlwdtg,lwdtclr,lwgclr,
184 . nlwcld,cldtot_lw,cldras_lw,nlwlz,lwlz,
185 . .false.,imstturblw,qliqavelw,
186 . fccavelw,landtype )
187
188 ENDIF
189
190 C TURBULENCE
191 C ==========
192 IF ( alarm('turb') ) THEN
193
194 if(2.eq.1)then
195 print *,' In fizhi driver, before turb - bi = ',bi
196 do j = 1,jm
197 do i = 1,im
198 tempij(i,j) = radswt(i,j)
199 enddo
200 enddo
201 print *,' radswt ',tempij
202 do j = 1,jm
203 do i = 1,im
204 tempij(i,j) = radswg(i,j)
205 enddo
206 enddo
207 print *,' radswg ',tempij
208 do j = 1,jm
209 do i = 1,im
210 tempij(i,j) = st4(i,j)
211 enddo
212 enddo
213 print *,' st4 ',tempij
214 do j = 1,jm
215 do i = 1,im
216 tempij(i,j) = dst4(i,j)
217 enddo
218 enddo
219 print *,' dst4 ',tempij
220 do j = 1,jm
221 do i = 1,im
222 tempij(i,j) = radlwg(i,j)
223 enddo
224 enddo
225 print *,' radlwg ',tempij
226 do j = 1,jm
227 do i = 1,im
228 tempij(i,j) = fdifpar(i,j)
229 enddo
230 enddo
231 print *,' fdifpar ',tempij
232 do j = 1,jm
233 do i = 1,im
234 tempij(i,j) = fdirpar(i,j)
235 enddo
236 enddo
237 print *,' fdirpar ',tempij
238 do j = 1,jm
239 do i = 1,im
240 tempij(i,j) = tgz(i,j)
241 enddo
242 enddo
243 print *,' tgz ',tempij
244 do j = 1,jm
245 do i = 1,im
246 tempij(i,j) = tg0(i,j)
247 enddo
248 enddo
249 print *,' tg0 ',tempij
250 endif
251
252 call turbio (im,jm,lm,istrip,nymd,nhms,bi,bj,ndturb,
253 . ptop,p,u,v,t,q,ntracer,ptracer,pl,ple,dpres,pkht,pkl,
254 . ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
255 . tgz,fracland,landtype,
256 . tcanopy,ecanopy,tdeep,swetshal,swetroot,swetdeep,snodep,capac,
257 . nchp,nchptot,nchpland,chfr,chlat,chlon,igrd,ityp,
258 . alai,agrn,sea_ice,lpnt,
259 . turbu,turbv,turbt,turbq,radlwg,st4,dst4,radswg,radswt,
260 . fdifpar,fdirpar,rainlsp,raincon,snowfall,tg0,
261 . imstturblw,imstturbsw,qliqavelw,qliqavesw,fccavelw,fccavesw,qq,
262 . myid)
263
264 c Add Gravity-Wave Drag Tendency
265 c ------------------------------
266 C Comment this out for now - run tropospheric resolutions only.
267 C Need to see how to get zonal wavelengths on the cube.
268
269 c call gwdrag (myid,p,pl,ple,dpres,pkht,pkl,u,v,t,q,phis_var,
270 c . turbu,turbv,turbt,im,jm,lm,ptop,istrip,npcs,
271 c . imglobal)
272
273 endif
274
275 C MOIST PROCESSES
276 C ===============
277 if ( alarm('moist') ) then
278 call moistio (ndmoist,istrip,npcs,
279 . low_level,mid_level,nltop,nsubmin,nsubmax,Lup,
280 . p,pl,ple,dpres,pkht,pkl,t,q,bi,bj,ntracer,ptracer,qq,
281 . moistu,moistv,moistt,moistq,im,jm,lm,ptop,iras,
282 . rainlsp,raincon,snowfall,
283 . nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
284 . nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
285 . .false.,myid)
286
287 endif
288
289 return
290 end

  ViewVC Help
Powered by ViewVC 1.1.22