/[MITgcm]/MITgcm/verification/fizhi-gridalt-hs/code/do_fizhi.F
ViewVC logotype

Diff of /MITgcm/verification/fizhi-gridalt-hs/code/do_fizhi.F

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

revision 1.3 by molod, Wed Sep 29 14:47:54 2004 UTC revision 1.4 by molod, Thu Sep 30 16:11:00 2004 UTC
# Line 140  c     save imstturbsw,imstturblw,qliqave Line 140  c     save imstturbsw,imstturblw,qliqave
140  c     save qq  c     save qq
141  c     save pl,ple,dpres,pkle,pkl  c     save pl,ple,dpres,pkle,pkl
142                
143  c     common /saver/ lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq        common /saver/ lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq
144  c     common /saver/ moistu,moistv,moistt,moistq        common /saver/ moistu,moistv,moistt,moistq
145  c     common /saver/ radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg        common /saver/ radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg
146  c     common /saver/ st4,dst4,dlwdtg,rainlsp,raincon,snowfall        common /saver/ st4,dst4,dlwdtg,rainlsp,raincon,snowfall
147  c     common /saver/ cldtot_lw,cldras_lw,cldlsp_lw,lwlz        common /saver/ cldtot_lw,cldras_lw,cldlsp_lw,lwlz
148  c     common /saver/ cldtot_sw,cldras_sw,cldlsp_sw,swlz        common /saver/ cldtot_sw,cldras_sw,cldlsp_sw,swlz
149  c     common /saver/ imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw        common /saver/ imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw
150  c     common /saver/ fccavelw        common /saver/ fccavelw
151  c     common /saver/ qq        common /saver/ qq
152  c     common /saver/ pl,ple,dpres,pkle,pkl        common /saver/ pl,ple,dpres,pkle,pkl
153  c     common /saver/ nlwcld,nlwlz        common /saver/ nlwcld,nlwlz
154  c     common /saver/ nswcld,nswlz        common /saver/ nswcld,nswlz
155  c     common /saver/ iras        common /saver/ iras
156    
157  C***********************************************************************  C***********************************************************************
158  C Unshadow input arrays (and make 'fizhi theta' from true theta)  C Unshadow input arrays (and make 'fizhi theta' from true theta)
159  C***********************************************************************  C***********************************************************************
160    
161  c     if( (nhms.eq.nhms0) .and. (nymd.eq.nymd0) ) then  Creal if( (nhms.eq.nhms0) .and. (nymd.eq.nymd0) ) then
162  c      _BEGIN_MASTER(myid)  Creal  _BEGIN_MASTER(myid)
163  c      if(myid.eq.1.and.bi.eq.1) print *,' Initializing fizhi arrays '  Creal  if(myid.eq.1.and.bi.eq.1) print *,' Initializing fizhi arrays '
164  c      _END_MASTER(myid)  Creal  _END_MASTER(myid)
165  c      imstturblw = 0  Creal  imstturblw = 0
166  c      imstturbsw = 0  Creal  imstturbsw = 0
167  c      iras = 0  Creal  iras = 0
168  c      nlwcld = 0  Creal  nlwcld = 0
169  c      nlwlz = 0  Creal  nlwlz = 0
170  c      nswcld = 0  Creal  nswcld = 0
171  c      nswlz = 0  Creal  nswlz = 0
172  c      do L = 1,Nrphys  Creal  do L = 1,Nrphys
173  c      do j = jm1,jm2  Creal  do j = jm1,jm2
174  c      do i = im1,im2  Creal  do i = im1,im2
175  c       swlz(i,j,L,bi,bj) = 0.  Creal   swlz(i,j,L,bi,bj) = 0.
176  c       lwlz(i,j,L,bi,bj) = 0.  Creal   lwlz(i,j,L,bi,bj) = 0.
177  c       qliqavesw(i,j,L,bi,bj) = 0.  Creal   qliqavesw(i,j,L,bi,bj) = 0.
178  c       qliqavelw(i,j,L,bi,bj) = 0.  Creal   qliqavelw(i,j,L,bi,bj) = 0.
179  c       fccavesw(i,j,L,bi,bj) = 0.  Creal   fccavesw(i,j,L,bi,bj) = 0.
180  c       fccavelw(i,j,L,bi,bj) = 0.  Creal   fccavelw(i,j,L,bi,bj) = 0.
181  c       cldtot_sw(i,j,L,bi,bj) = 0.  Creal   cldtot_sw(i,j,L,bi,bj) = 0.
182  c       cldras_sw(i,j,L,bi,bj) = 0.  Creal   cldras_sw(i,j,L,bi,bj) = 0.
183  c       cldlsp_sw(i,j,L,bi,bj) = 0.  Creal   cldlsp_sw(i,j,L,bi,bj) = 0.
184  c       cldtot_lw(i,j,L,bi,bj) = 0.  Creal   cldtot_lw(i,j,L,bi,bj) = 0.
185  c       cldras_lw(i,j,L,bi,bj) = 0.  Creal   cldras_lw(i,j,L,bi,bj) = 0.
186  c       cldlsp_lw(i,j,L,bi,bj) = 0.  Creal   cldlsp_lw(i,j,L,bi,bj) = 0.
187  c       lwdt(i,j,L,bi,bj) = 0.  Creal   lwdt(i,j,L,bi,bj) = 0.
188  c       swdt(i,j,L,bi,bj) = 0.  Creal   swdt(i,j,L,bi,bj) = 0.
189  c       turbt(i,j,L,bi,bj) = 0.  Creal   turbt(i,j,L,bi,bj) = 0.
190  c       moistt(i,j,L,bi,bj) = 0.  Creal   moistt(i,j,L,bi,bj) = 0.
191  c       turbq(i,j,L,1,bi,bj) = 0.  Creal   turbq(i,j,L,1,bi,bj) = 0.
192  c       moistq(i,j,L,1,bi,bj) = 0.  Creal   moistq(i,j,L,1,bi,bj) = 0.
193  c       turbu(i,j,L,bi,bj) = 0.  Creal   turbu(i,j,L,bi,bj) = 0.
194  c       moistu(i,j,L,bi,bj) = 0.  Creal   moistu(i,j,L,bi,bj) = 0.
195  c       turbv(i,j,L,bi,bj) = 0.  Creal   turbv(i,j,L,bi,bj) = 0.
196  c       moistv(i,j,L,bi,bj) = 0.  Creal   moistv(i,j,L,bi,bj) = 0.
197  c      enddo  Creal  enddo
198  c      enddo  Creal  enddo
199  c      enddo  Creal  enddo
200  c      do j = jm1,jm2  Creal  do j = jm1,jm2
201  c      do i = im1,im2  Creal  do i = im1,im2
202  c       rainlsp(i,j,bi,bj) = 0.  Creal   rainlsp(i,j,bi,bj) = 0.
203  c       raincon(i,j,bi,bj) = 0.  Creal   raincon(i,j,bi,bj) = 0.
204  c       snowfall(i,j,bi,bj) = 0.  Creal   snowfall(i,j,bi,bj) = 0.
205  c      enddo  Creal  enddo
206  c      enddo  Creal  enddo
207  c     endif  Creal endif
208  c  Creal
209  c     kappa = getcon('KAPPA')  Creal kappa = getcon('KAPPA')
210  c     p0kappa = 1000.0 ** kappa  Creal p0kappa = 1000.0 ** kappa
211  c     S0 = getcon('S0')  Creal S0 = getcon('S0')
212  c        Creal  
213  c     do j = jm1,jm2  Creal do j = jm1,jm2
214  c     do i = im1,im2  Creal do i = im1,im2
215  c      xlats(i,j) = lats(i,j,bi,bj)  Creal  xlats(i,j) = lats(i,j,bi,bj)
216  c      xlons(i,j) = lons(i,j,bi,bj)  Creal  xlons(i,j) = lons(i,j,bi,bj)
217  c     enddo  Creal enddo
218  c     enddo  Creal enddo
219  c  Creal
220  c     call astro ( nymd,nhms, xlats,xlons, im2*jm2, cosz,ra )  Creal call astro ( nymd,nhms, xlats,xlons, im2*jm2, cosz,ra )
221  c     do j=jm1,jm2  Creal do j=jm1,jm2
222  c     do i=im1,im2  Creal do i=im1,im2
223  c      radswt(i,j,bi,bj) = S0*(1.0/ra**2)*cosz(i,j)  Creal  radswt(i,j,bi,bj) = S0*(1.0/ra**2)*cosz(i,j)
224  c     enddo  Creal enddo
225  c     enddo  Creal enddo
226  c  Creal
227  c     if( alarm('moist') .or. alarm('turb')   .or.  Creal if( alarm('moist') .or. alarm('turb')   .or.
228  c    .    alarm('radsw') .or. alarm('radlw') ) then  Creal.    alarm('radsw') .or. alarm('radlw') ) then
229  c  Creal
230  C compute pressures - all pressure are converted here to hPa  Crealpute pressures - all pressure are converted here to hPa
231  c     do j = jm1,jm2  Creal do j = jm1,jm2
232  c     do i = im1,im2  Creal do i = im1,im2
233  c      ple(i,j,Nrphys+1,bi,bj) = pephy(i,j,Nrphys+1,bi,bj)/100.  Creal  ple(i,j,Nrphys+1,bi,bj) = pephy(i,j,Nrphys+1,bi,bj)/100.
234  c      pkle(i,j,Nrphys+1,bi,bj)=(pephy(i,j,Nrphys+1,bi,bj)/100.) **kappa  Creal  pkle(i,j,Nrphys+1,bi,bj)=(pephy(i,j,Nrphys+1,bi,bj)/100.) **kappa
235  c      p(i,j,bi,bj) = pephy(i,j,Nrphys+1,bi,bj)/100.  Creal  p(i,j,bi,bj) = pephy(i,j,Nrphys+1,bi,bj)/100.
236  c      sea_ice(i,j) = sice(i,j,bi,bj)  Creal  sea_ice(i,j) = sice(i,j,bi,bj)
237  c     enddo  Creal enddo
238  c     enddo  Creal enddo
239  c     do L = 1,Nrphys  Creal do L = 1,Nrphys
240  c     do j = jm1,jm2  Creal do j = jm1,jm2
241  c     do i = im1,im2  Creal do i = im1,im2
242  c      u(i,j,L) = uphy(i,j,L,bi,bj)  Creal  u(i,j,L) = uphy(i,j,L,bi,bj)
243  c      v(i,j,L) = vphy(i,j,L,bi,bj)  Creal  v(i,j,L) = vphy(i,j,L,bi,bj)
244  c      t(i,j,L) = thphy(i,j,L,bi,bj)/p0kappa  Creal  t(i,j,L) = thphy(i,j,L,bi,bj)/p0kappa
245  c      q(i,j,L,1) = sphy(i,j,L,bi,bj)  Creal  q(i,j,L,1) = sphy(i,j,L,bi,bj)
246  c      pl(i,j,L,bi,bj) = (pephy(i,j,L,bi,bj)+pephy(i,j,L+1,bi,bj))/200.  Creal  pl(i,j,L,bi,bj) = (pephy(i,j,L,bi,bj)+pephy(i,j,L+1,bi,bj))/200.
247  c      dpres(i,j,L,bi,bj)=(pephy(i,j,L+1,bi,bj)-pephy(i,j,L,bi,bj))/100.  Creal  dpres(i,j,L,bi,bj)=(pephy(i,j,L+1,bi,bj)-pephy(i,j,L,bi,bj))/100.
248  c      ple(i,j,L,bi,bj) = pephy(i,j,L,bi,bj)/100.  Creal  ple(i,j,L,bi,bj) = pephy(i,j,L,bi,bj)/100.
249  c      if (ple(i,j,L,bi,bj).gt.0.) then  Creal  if (ple(i,j,L,bi,bj).gt.0.) then
250  c       pkle(i,j,L,bi,bj) = ple(i,j,L,bi,bj) **kappa  Creal   pkle(i,j,L,bi,bj) = ple(i,j,L,bi,bj) **kappa
251  c      else  Creal  else
252  c       pkle(i,j,L,bi,bj) = 0.  Creal   pkle(i,j,L,bi,bj) = 0.
253  c      endif  Creal  endif
254  c     enddo  Creal enddo
255  c     enddo  Creal enddo
256  c     enddo  Creal enddo
257  c  Creal
258  c     call pkappa (im2,jm2,Nrphys,ple(1,1,1,bi,bj),pkle(1,1,1,bi,bj),  Creal call pkappa (im2,jm2,Nrphys,ple(1,1,1,bi,bj),pkle(1,1,1,bi,bj),
259  c    .                                                 pkl(1,1,1,bi,bj))  Creal.                                                 pkl(1,1,1,bi,bj))
260  c  Creal
261  c     call fizhi_driver(myid,im2,jm2,Nrphys,bi,bj,ptracer,ntracer,xlats,  Creal call fizhi_driver(myid,im2,jm2,Nrphys,bi,bj,ptracer,ntracer,xlats,
262  c    . xlons,p(1,1,bi,bj),u,v,t,q,pl(1,1,1,bi,bj),ple(1,1,1,bi,bj),  Creal. xlons,p(1,1,bi,bj),u,v,t,q,pl(1,1,1,bi,bj),ple(1,1,1,bi,bj),
263  c    . dpres(1,1,1,bi,bj),pkle(1,1,1,bi,bj),pkl(1,1,1,bi,bj),  Creal. dpres(1,1,1,bi,bj),pkle(1,1,1,bi,bj),pkl(1,1,1,bi,bj),
264  c    . fracland(1,1,bi,bj),landtype(1,1,bi,bj),radswt(1,1,bi,bj),  Creal. fracland(1,1,bi,bj),landtype(1,1,bi,bj),radswt(1,1,bi,bj),
265  c    . phis_var(1,1,bi,bj),tgz(1,1,bi,bj),sea_ice,nchp,chlat(1,bi,bj),  Creal. phis_var(1,1,bi,bj),tgz(1,1,bi,bj),sea_ice,nchp,chlat(1,bi,bj),
266  c    . chlon(1,bi,bj),igrd(1,bi,bj),nchptot(bi,bj),nchpland(bi,bj),  Creal. chlon(1,bi,bj),igrd(1,bi,bj),nchptot(bi,bj),nchpland(bi,bj),
267  c    . chfr(1,bi,bj),ityp(1,bi,bj),tcanopy(1,bi,bj),tdeep(1,bi,bj),  Creal. chfr(1,bi,bj),ityp(1,bi,bj),tcanopy(1,bi,bj),tdeep(1,bi,bj),
268  c    . ecanopy(1,bi,bj),swetshal(1,bi,bj),swetroot(1,bi,bj),  Creal. ecanopy(1,bi,bj),swetshal(1,bi,bj),swetroot(1,bi,bj),
269  c    . swetdeep(1,bi,bj),capac(1,bi,bj),snodep(1,bi,bj),  Creal. swetdeep(1,bi,bj),capac(1,bi,bj),snodep(1,bi,bj),
270  c    . ctmt(1,bi,bj),xxmt(1,bi,bj),yymt(1,bi,bj),zetamt(1,bi,bj),  Creal. ctmt(1,bi,bj),xxmt(1,bi,bj),yymt(1,bi,bj),zetamt(1,bi,bj),
271  c    . xlmt(1,1,bi,bj),khmt(1,1,bi,bj),tke(1,1,bi,bj),  Creal. xlmt(1,1,bi,bj),khmt(1,1,bi,bj),tke(1,1,bi,bj),
272  c    . albvisdr(1,1,bi,bj),albvisdf(1,1,bi,bj),albnirdr(1,1,bi,bj),  Creal. albvisdr(1,1,bi,bj),albvisdf(1,1,bi,bj),albnirdr(1,1,bi,bj),
273  c    . albnirdf(1,1,bi,bj),emiss(1,1,1,bi,bj),alai(1,bi,bj),  Creal. albnirdf(1,1,bi,bj),emiss(1,1,1,bi,bj),alai(1,bi,bj),
274  c    . agrn(1,bi,bj),  Creal. agrn(1,bi,bj),
275  c    . qstr(1,1,1,bi,bj),o3(1,1,1,bi,bj),  Creal. qstr(1,1,1,bi,bj),o3(1,1,1,bi,bj),
276  c    . co2,cfc11,cfc12,cfc22,methane,n2o,  Creal. co2,cfc11,cfc12,cfc22,methane,n2o,
277  c    . lwdt(1,1,1,bi,bj),lwdtclr(1,1,1,bi,bj),swdt(1,1,1,bi,bj),  Creal. lwdt(1,1,1,bi,bj),lwdtclr(1,1,1,bi,bj),swdt(1,1,1,bi,bj),
278  c    . swdtclr(1,1,1,bi,bj),turbu(1,1,1,bi,bj),turbv(1,1,1,bi,bj),  Creal. swdtclr(1,1,1,bi,bj),turbu(1,1,1,bi,bj),turbv(1,1,1,bi,bj),
279  c    . turbt(1,1,1,bi,bj),turbq(1,1,1,1,bi,bj),moistu(1,1,1,bi,bj),  Creal. turbt(1,1,1,bi,bj),turbq(1,1,1,1,bi,bj),moistu(1,1,1,bi,bj),
280  c    . moistv(1,1,1,bi,bj),moistt(1,1,1,bi,bj),moistq(1,1,1,1,bi,bj),  Creal. moistv(1,1,1,bi,bj),moistt(1,1,1,bi,bj),moistq(1,1,1,1,bi,bj),
281  c    . radswg(1,1,bi,bj),swgclr(1,1,bi,bj),fdirpar(1,1,bi,bj),  Creal. radswg(1,1,bi,bj),swgclr(1,1,bi,bj),fdirpar(1,1,bi,bj),
282  c    . fdifpar(1,1,bi,bj),osr(1,1,bi,bj),osrclr(1,1,bi,bj),  Creal. fdifpar(1,1,bi,bj),osr(1,1,bi,bj),osrclr(1,1,bi,bj),
283  c    . tg0(1,1,bi,bj),radlwg(1,1,bi,bj),lwgclr(1,1,bi,bj),  Creal. tg0(1,1,bi,bj),radlwg(1,1,bi,bj),lwgclr(1,1,bi,bj),
284  c    . st4(1,1,bi,bj),dst4(1,1,bi,bj),dlwdtg(1,1,1,bi,bj),  Creal. st4(1,1,bi,bj),dst4(1,1,bi,bj),dlwdtg(1,1,1,bi,bj),
285  c    . rainlsp(1,1,bi,bj),raincon(1,1,bi,bj),snowfall(1,1,bi,bj),iras,  Creal. rainlsp(1,1,bi,bj),raincon(1,1,bi,bj),snowfall(1,1,bi,bj),iras,
286  c    . nlwcld,cldtot_lw(1,1,1,bi,bj),cldras_lw(1,1,1,bi,bj),  Creal. nlwcld,cldtot_lw(1,1,1,bi,bj),cldras_lw(1,1,1,bi,bj),
287  c    . cldlsp_lw(1,1,1,bi,bj),nlwlz,lwlz(1,1,1,bi,bj),  Creal. cldlsp_lw(1,1,1,bi,bj),nlwlz,lwlz(1,1,1,bi,bj),
288  c    . nswcld,cldtot_sw(1,1,1,bi,bj),cldras_sw(1,1,1,bi,bj),  Creal. nswcld,cldtot_sw(1,1,1,bi,bj),cldras_sw(1,1,1,bi,bj),
289  c    . cldlsp_sw(1,1,1,bi,bj),nswlz,swlz(1,1,1,bi,bj),  Creal. cldlsp_sw(1,1,1,bi,bj),nswlz,swlz(1,1,1,bi,bj),
290  c    . imstturbsw,imstturblw,qliqavesw(1,1,1,bi,bj),  Creal. imstturbsw,imstturblw,qliqavesw(1,1,1,bi,bj),
291  c    . qliqavelw(1,1,1,bi,bj),fccavesw(1,1,1,bi,bj),  Creal. qliqavelw(1,1,1,bi,bj),fccavesw(1,1,1,bi,bj),
292  c    . fccavelw(1,1,1,bi,bj),qq(1,1,1,bi,bj))  Creal. fccavelw(1,1,1,bi,bj),qq(1,1,1,bi,bj))
293  c  Creal
294  c     do L = 1,Nrphys  Creal do L = 1,Nrphys
295  c     do j = jm1,jm2  Creal do j = jm1,jm2
296  c     do i = im1,im2  Creal do i = im1,im2
297  c      duphy(i,j,L,bi,bj) = moistu(i,j,L,bi,bj) + turbu(i,j,L,bi,bj)  Creal  duphy(i,j,L,bi,bj) = moistu(i,j,L,bi,bj) + turbu(i,j,L,bi,bj)
298  c      dvphy(i,j,L,bi,bj) = moistv(i,j,L,bi,bj) + turbv(i,j,L,bi,bj)  Creal  dvphy(i,j,L,bi,bj) = moistv(i,j,L,bi,bj) + turbv(i,j,L,bi,bj)
299  c      dthphy(i,j,L,bi,bj) = ((moistt(i,j,L,bi,bj)+turbt(i,j,L,bi,bj)+  Creal  dthphy(i,j,L,bi,bj) = ((moistt(i,j,L,bi,bj)+turbt(i,j,L,bi,bj)+
300  c    .   lwdt(i,j,L,bi,bj) +  Creal.   lwdt(i,j,L,bi,bj) +
301  c    .   dlwdtg(i,j,L,bi,bj) * (tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) +  Creal.   dlwdtg(i,j,L,bi,bj) * (tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) +
302  c    .   swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )*p0kappa ) / p(i,j,bi,bj)  Creal.   swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )*p0kappa ) / p(i,j,bi,bj)
303  c      dsphy(i,j,L,bi,bj) = (moistq(i,j,L,1,bi,bj)+turbq(i,j,L,1,bi,bj))  Creal  dsphy(i,j,L,bi,bj) = (moistq(i,j,L,1,bi,bj)+turbq(i,j,L,1,bi,bj))
304  c    .                                    /p(i,j,bi,bj)  Creal.                                    /p(i,j,bi,bj)
305  c     enddo  Creal enddo
306  c     enddo  Creal enddo
307  c     enddo  Creal enddo
308  c  Creal
309  c     endif  Creal endif
310  c  Creal
311  c     call fizhi_step_diag(myid,p,uphy,vphy,thphy,sphy,qq,pkl,dpres,  Creal call fizhi_step_diag(myid,p,uphy,vphy,thphy,sphy,qq,pkl,dpres,
312  c    .  radswt,radswg,swgclr,osr,osrclr,st4,dst4,tgz,tg0,radlwg,lwgclr,  Creal.  radswt,radswg,swgclr,osr,osrclr,st4,dst4,tgz,tg0,radlwg,lwgclr,
313  c    .  turbu,turbv,turbt,turbq,moistu,moistv,moistt,moistq,  Creal.  turbu,turbv,turbt,turbq,moistu,moistv,moistt,moistq,
314  c    .  lwdt,swdt,lwdtclr,swdtclr,dlwdtg,  Creal.  lwdt,swdt,lwdtclr,swdtclr,dlwdtg,
315  c    .  im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,bi,bj,ntracer)  Creal.  im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,bi,bj,ntracer)
316    Creal
317    
318         kF=1. _d 0/86400. _d 0         kF=1. _d 0/86400. _d 0
319         sigma_b = 0.7 _d 0         sigma_b = 0.7 _d 0
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22