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

Diff of /MITgcm/pkg/fizhi/do_fizhi.F

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

revision 1.21 by molod, Sun Jul 18 23:17:00 2004 UTC revision 1.22 by molod, Mon Jul 19 22:06:59 2004 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
4         subroutine do_fizhi(myid,uphy,vphy,thphy,sphy,pephy,lons,lats,         subroutine do_fizhi(myid,uphy,vphy,thphy,sphy,pephy,lons,lats,
5       .   ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,       . ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
6       .   tgz,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,       . tgz,sice,phis_var,landtype,fracland,emiss,albnirdr,albnirdf,
7       .   albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlat,chlon,       . albvisdr,albvisdf,ityp,chfr,alai,agrn,igrd,chlat,chlon,
8       .   tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,       . tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,snodep,capac,
9       .   o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,       . o3,qstr,co2,cfc11,cfc12,cfc22,n2o,methane,
10       .   idim1,idim2,jdim1,jdim2,Nrphys,Nsx,Nsy,im1,im2,jm1,jm2,bi,bj,       . idim1,idim2,jdim1,jdim2,Nrphin,Nsxin,Nsyin,im1,im2,jm1,jm2,bi,bj,
11       .   nchp,nchpland,       . nchp,nchpland,
12       .   duphy,dvphy,dthphy,dsphy)       . duphy,dvphy,dthphy,dsphy)
13  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
14  c Interface routine to calculate physics increments - calls fizhi_driver.  c Interface routine to calculate physics increments - calls fizhi_driver.
15  c Purpose of this routine is to set up arrays local to fizhi and 'save'  c Purpose of this routine is to set up arrays local to fizhi and 'save'
# Line 21  c Note: routine is called from inside a Line 21  c Note: routine is called from inside a
21  c  c
22  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
23        implicit none        implicit none
24    #include "SIZE.h"
25    #include "fizhi_SIZE.h"
26  #include "chronos.h"  #include "chronos.h"
27    
28  C Argument list declarations  C Argument list declarations
29        integer myid,im1,im2,jm1,jm2,idim1,idim2,jdim1,jdim2        integer myid,im1,im2,jm1,jm2,idim1,idim2,jdim1,jdim2
30        integer Nrphys,Nsx,Nsy,bi,bj,nchp,nchpland        integer Nrphin,Nsxin,Nsyin,bi,bj,nchp,nchpland
31        _RL uphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL uphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
32        _RL vphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL vphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
33        _RL thphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL thphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
34        _RL sphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL sphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
35        _RL pephy(idim1:idim2,jdim1:jdim2,Nrphys+1,Nsx,Nsy)        _RL pephy(idim1:idim2,jdim1:jdim2,Nrphin+1,Nsxin,Nsyin)
36        _RL lons(idim1:idim2,jdim1:jdim2,Nsx,Nsy)        _RL lons(idim1:idim2,jdim1:jdim2,Nsxin,Nsyin)
37        _RL lats(idim1:idim2,jdim1:jdim2,Nsx,Nsy)        _RL lats(idim1:idim2,jdim1:jdim2,Nsxin,Nsyin)
38        _RL ctmt(nchp,Nsx,Nsy),xxmt(nchp,Nsx,Nsy),yymt(nchp,Nsx,Nsy)        _RL ctmt(nchp,Nsxin,Nsyin),xxmt(nchp,Nsxin,Nsyin)
39        _RL zetamt(nchp,Nsx,Nsy)        _RL yymt(nchp,Nsxin,Nsyin)
40        _RL xlmt(nchp,Nrphys,Nsx,Nsy),khmt(nchp,Nrphys,Nsx,Nsy)        _RL zetamt(nchp,Nsxin,Nsyin)
41        _RL tke(nchp,Nrphys,Nsx,Nsy)        _RL xlmt(nchp,Nrphin,Nsxin,Nsyin),khmt(nchp,Nrphin,Nsxin,Nsyin)
42        _RL tgz(im2,jm2,Nsx,Nsy)        _RL tke(nchp,Nrphin,Nsxin,Nsyin)
43        _RL sice(idim1:idim2,jdim1:jdim2,Nsx,Nsy)        _RL tgz(im2,jm2,Nsxin,Nsyin)
44        _RL phis_var(im2,jm2,Nsx,Nsy),landtype(im2,jm2,Nsx,Nsy)        _RL sice(idim1:idim2,jdim1:jdim2,Nsxin,Nsyin)
45        _RL fracland(im2,jm2,Nsx,Nsy),emiss(im2,jm2,10,Nsx,Nsy)        _RL phis_var(im2,jm2,Nsxin,Nsyin),landtype(im2,jm2,Nsxin,Nsyin)
46        _RL albvisdr(im2,jm2,Nsx,Nsy),albvisdf(im2,jm2,Nsx,Nsy)        _RL fracland(im2,jm2,Nsxin,Nsyin),emiss(im2,jm2,10,Nsxin,Nsyin)
47        _RL albnirdr(im2,jm2,Nsx,Nsy),albnirdf(im2,jm2,Nsx,Nsy)        _RL albvisdr(im2,jm2,Nsxin,Nsyin),albvisdf(im2,jm2,Nsxin,Nsyin)
48        _RL chfr(nchp,Nsx,Nsy),alai(nchp,Nsx,Nsy),agrn(nchp,Nsx,Nsy)        _RL albnirdr(im2,jm2,Nsxin,Nsyin),albnirdf(im2,jm2,Nsxin,Nsyin)
49        integer ityp(nchp,Nsx,Nsy),igrd(nchp,Nsx,Nsy)        _RL chfr(nchp,Nsxin,Nsyin),alai(nchp,Nsxin,Nsyin)
50        _RL chlat(nchp,Nsx,Nsy),chlon(nchp,Nsx,Nsy)        _RL agrn(nchp,Nsxin,Nsyin)
51        _RL tcanopy(nchp,Nsx,Nsy),tdeep(nchp,Nsx,Nsy)        integer ityp(nchp,Nsxin,Nsyin),igrd(nchp,Nsxin,Nsyin)
52        _RL ecanopy(nchp,Nsx,Nsy),swetshal(nchp,Nsx,Nsy)        _RL chlat(nchp,Nsxin,Nsyin),chlon(nchp,Nsxin,Nsyin)
53        _RL swetroot(nchp,Nsx,Nsy),swetdeep(nchp,Nsx,Nsy)        _RL tcanopy(nchp,Nsxin,Nsyin),tdeep(nchp,Nsxin,Nsyin)
54        _RL snodep(nchp,Nsx,Nsy),capac(nchp,Nsx,Nsy)        _RL ecanopy(nchp,Nsxin,Nsyin),swetshal(nchp,Nsxin,Nsyin)
55        _RL o3(im2,jm2,Nsx,Nsy),qstr(im2,jm2,Nsx,Nsy)        _RL swetroot(nchp,Nsxin,Nsyin),swetdeep(nchp,Nsxin,Nsyin)
56        _RL co2,cfc11,cfc12,cfc22,n2o(Nrphys),methane(Nrphys)        _RL snodep(nchp,Nsxin,Nsyin),capac(nchp,Nsxin,Nsyin)
57        _RL duphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL o3(im2,jm2,Nsxin,Nsyin),qstr(im2,jm2,Nsxin,Nsyin)
58        _RL dvphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL co2,cfc11,cfc12,cfc22,n2o(Nrphin),methane(Nrphin)
59        _RL dthphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL duphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
60        _RL dsphy(idim1:idim2,jdim1:jdim2,Nrphys,Nsx,Nsy)        _RL dvphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
61  c        _RL dthphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
62          _RL dsphy(idim1:idim2,jdim1:jdim2,Nrphin,Nsxin,Nsyin)
63    
64    c Local Variables
65        integer ptracer,ntracer        integer ptracer,ntracer
66        parameter (ptracer = 1)        parameter (ptracer = 1)
67        parameter (ntracer = 1)        parameter (ntracer = 1)
68        integer iras,nlwcld,nlwlz,nswcld,nswlz        integer iras,nlwcld,nlwlz,nswcld,nswlz
69        integer imstturbsw,imstturblw        integer imstturbsw,imstturblw
70    
71        real xlats(im2,jm2), xlons(im2,jm2), sea_ice(im2,jm2)        real xlats(sNx,sNy), xlons(sNx,sNy), sea_ice(sNx,sNy)
72        real p(im2,jm2,Nsx,Nsy)        real p(sNx,sNy,Nsx,Nsy)
73        real u(im2,jm2,Nrphys), v(im2,jm2,Nrphys), t(im2,jm2,Nrphys)        real u(sNx,sNy,Nrphys), v(sNx,sNy,Nrphys), t(sNx,sNy,Nrphys)
74        real q(im2,jm2,Nrphys,ntracer)        real q(sNx,sNy,Nrphys,ntracer)
75        real pl(im2,jm2,Nrphys,Nsx,Nsy),pkl(im2,jm2,Nrphys,Nsx,Nsy)        real pl(sNx,sNy,Nrphys,Nsx,Nsy),pkl(sNx,sNy,Nrphys,Nsx,Nsy)
76        real ple(im2,jm2,Nrphys+1,Nsx,Nsy),pkle(im2,jm2,Nrphys+1,Nsx,Nsy)        real ple(sNx,sNy,Nrphys+1,Nsx,Nsy),pkle(sNx,sNy,Nrphys+1,Nsx,Nsy)
77        real dpres(im2,jm2,Nrphys,Nsx,Nsy)        real dpres(sNx,sNy,Nrphys,Nsx,Nsy)
78        real lwdt(im2,jm2,Nrphys,Nsx,Nsy),lwdtclr(im2,jm2,Nrphys,Nsx,Nsy)        real lwdt(sNx,sNy,Nrphys,Nsx,Nsy),lwdtclr(sNx,sNy,Nrphys,Nsx,Nsy)
79        real swdt(im2,jm2,Nrphys,Nsx,Nsy),swdtclr(im2,jm2,Nrphys,Nsx,Nsy)        real swdt(sNx,sNy,Nrphys,Nsx,Nsy),swdtclr(sNx,sNy,Nrphys,Nsx,Nsy)
80        real turbu(im2,jm2,Nrphys,Nsx,Nsy),turbv(im2,jm2,Nrphys,Nsx,Nsy)        real turbu(sNx,sNy,Nrphys,Nsx,Nsy),turbv(sNx,sNy,Nrphys,Nsx,Nsy)
81        real turbt(im2,jm2,Nrphys,Nsx,Nsy)        real turbt(sNx,sNy,Nrphys,Nsx,Nsy)
82        real turbq(im2,jm2,Nrphys,ntracer,Nsx,Nsy)        real turbq(sNx,sNy,Nrphys,ntracer,Nsx,Nsy)
83        real moistu(im2,jm2,Nrphys,Nsx,Nsy),moistv(im2,jm2,Nrphys,Nsx,Nsy)        real moistu(sNx,sNy,Nrphys,Nsx,Nsy),moistv(sNx,sNy,Nrphys,Nsx,Nsy)
84        real moistt(im2,jm2,Nrphys,Nsx,Nsy)        real moistt(sNx,sNy,Nrphys,Nsx,Nsy)
85        real moistq(im2,jm2,Nrphys,ntracer,Nsx,Nsy)        real moistq(sNx,sNy,Nrphys,ntracer,Nsx,Nsy)
86        real radswt(im2,jm2,Nsx,Nsy),radswg(im2,jm2,Nsx,Nsy)        real radswt(sNx,sNy,Nsx,Nsy),radswg(sNx,sNy,Nsx,Nsy)
87        real swgclr(im2,jm2,Nsx,Nsy)        real swgclr(sNx,sNy,Nsx,Nsy)
88        real fdirpar(im2,jm2,Nsx,Nsy),fdifpar(im2,jm2,Nsx,Nsy)        real fdirpar(sNx,sNy,Nsx,Nsy),fdifpar(sNx,sNy,Nsx,Nsy)
89        real osr(im2,jm2,Nsx,Nsy),osrclr(im2,jm2,Nsx,Nsy)        real osr(sNx,sNy,Nsx,Nsy),osrclr(sNx,sNy,Nsx,Nsy)
90        real tg0(im2,jm2,Nsx,Nsy),radlwg(im2,jm2,Nsx,Nsy)        real tg0(sNx,sNy,Nsx,Nsy),radlwg(sNx,sNy,Nsx,Nsy)
91        real lwgclr(im2,jm2,Nsx,Nsy),st4(im2,jm2,Nsx,Nsy)        real lwgclr(sNx,sNy,Nsx,Nsy),st4(sNx,sNy,Nsx,Nsy)
92        real dst4(im2,jm2,Nsx,Nsy),dlwdtg(im2,jm2,Nrphys,Nsx,Nsy)        real dst4(sNx,sNy,Nsx,Nsy),dlwdtg(sNx,sNy,Nrphys,Nsx,Nsy)
93        real rainlsp(im2,jm2,Nsx,Nsy),raincon(im2,jm2,Nsx,Nsy)        real rainlsp(sNx,sNy,Nsx,Nsy),raincon(sNx,sNy,Nsx,Nsy)
94        real snowfall(im2,jm2,Nsx,Nsy)        real snowfall(sNx,sNy,Nsx,Nsy)
95        real cldtot_lw(im2,jm2,Nrphys,Nsx,Nsy)        real cldtot_lw(sNx,sNy,Nrphys,Nsx,Nsy)
96        real clras_lw(im2,jm2,Nrphys,Nsx,Nsy)        real clras_lw(sNx,sNy,Nrphys,Nsx,Nsy)
97        real cldlsp_lw(im2,jm2,Nrphys,Nsx,Nsy)        real cldlsp_lw(sNx,sNy,Nrphys,Nsx,Nsy)
98        real lwlz(im2,jm2,Nrphys,Nsx,Nsy)        real lwlz(sNx,sNy,Nrphys,Nsx,Nsy)
99        real cldtot_sw(im2,jm2,Nrphys,Nsx,Nsy)        real cldtot_sw(sNx,sNy,Nrphys,Nsx,Nsy)
100        real clras_sw(im2,jm2,Nrphys,Nsx,Nsy)        real clras_sw(sNx,sNy,Nrphys,Nsx,Nsy)
101        real cldlsp_sw(im2,jm2,Nrphys,Nsx,Nsy)        real cldlsp_sw(sNx,sNy,Nrphys,Nsx,Nsy)
102        real swlz(im2,jm2,Nrphys,Nsx,Nsy)        real swlz(sNx,sNy,Nrphys,Nsx,Nsy)
103        real qliqavesw(im2,jm2,Nrphys,Nsx,Nsy)        real qliqavesw(sNx,sNy,Nrphys,Nsx,Nsy)
104        real qliqavelw(im2,jm2,Nrphys,Nsx,Nsy)        real qliqavelw(sNx,sNy,Nrphys,Nsx,Nsy)
105        real fccavesw(im2,jm2,Nrphys,Nsx,Nsy)        real fccavesw(sNx,sNy,Nrphys,Nsx,Nsy)
106        real fccavelw(im2,jm2,Nrphys,Nsx,Nsy)        real fccavelw(sNx,sNy,Nrphys,Nsx,Nsy)
107        real qq(im2,jm2,Nrphys,Nsx,Nsy)        real qq(sNx,sNy,Nrphys,Nsx,Nsy)
108    
109        integer i,j,L        integer i,j,L
110        real getcon, kappa, p0kappa, s0, ra        real getcon, kappa, p0kappa, s0, ra
111        real cosz(im2,jm2)        real cosz(sNx,sNy)
112    
113        logical alarm        logical alarm
114        external alarm        external alarm
115    
116        save        save lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq
117          save moistu,moistv,moistt,moistq
118  c     save lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq        save radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg
119  c     save moistu,moistv,moistt,moistq        save st4,dst4,dlwdtg,rainlsp,raincon,snowfall,iras
120  c     save radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg        save nlwcld,cldtot_lw,clras_lw,cldlsp_lw,nlwlz,lwlz
121  c     save st4,dst4,dlwdtg,rainlsp,raincon,snowfall,iras        save nswcld,cldtot_sw,clras_sw,cldlsp_sw,nswlz,swlz
122  c     save nlwcld,cldtot_lw,clras_lw,cldlsp_lw,nlwlz,lwlz        save imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw,fccavelw
123  c     save nswcld,cldtot_sw,clras_sw,cldlsp_sw,nswlz,swlz,        save qq
124  c     save imstturbsw,imstturblw,qliqavesw,qliqavelw,fccavesw,fccavelw        save pl,ple,dpres,pkle,pkl
 c     save qq  
 c     save pl,ple,dpres,pkle,pkl  
125    
126  C***********************************************************************  C***********************************************************************
127  C Unshadow input arrays (and make 'fizhi theta' from true theta)  C Unshadow input arrays (and make 'fizhi theta' from true theta)
# Line 135  C*************************************** Line 138  C***************************************
138        enddo        enddo
139        enddo        enddo
140    
   
141        if( alarm('moist') .or. alarm('turb')   .or.        if( alarm('moist') .or. alarm('turb')   .or.
142       .    alarm('radsw') .or. alarm('radlw') ) then       .    alarm('radsw') .or. alarm('radlw') ) then
143    

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

  ViewVC Help
Powered by ViewVC 1.1.22