/[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.11 by molod, Wed Jun 16 20:23:55 2004 UTC revision 1.12 by molod, Thu Jun 17 16:07:06 2004 UTC
# Line 36  C Argument list declarations Line 36  C Argument list declarations
36        _RL zetamt(nchp,Nsx,Nsy)        _RL zetamt(nchp,Nsx,Nsy)
37        _RL xlmt(nchp,Nrphys,Nsx,Nsy),khmt(nchp,Nrphys,Nsx,Nsy)        _RL xlmt(nchp,Nrphys,Nsx,Nsy),khmt(nchp,Nrphys,Nsx,Nsy)
38        _RL tke(nchp,Nrphys,Nsx,Nsy)        _RL tke(nchp,Nrphys,Nsx,Nsy)
39        _RL tgz(im2,jm2)        _RL tgz(im2,jm2,Nsx,Nsy)
40        _RL sice(idim1:idim2,jdim1:jdim2,Nsx,Nsy)        _RL sice(idim1:idim2,jdim1:jdim2,Nsx,Nsy)
41        _RL phis_var(im2,jm2,Nsx,Nsy),landtype(im2,jm2,Nsx,Nsy)        _RL phis_var(im2,jm2,Nsx,Nsy),landtype(im2,jm2,Nsx,Nsy)
42        _RL fracland(im2,jm2,Nsx,Nsy),emiss(im2,jm2,10,Nsx,Nsy)        _RL fracland(im2,jm2,Nsx,Nsy),emiss(im2,jm2,10,Nsx,Nsy)
# Line 74  c Line 74  c
74        real radswt(im2,jm2),radswg(im2,jm2),swgclr(im2,jm2)        real radswt(im2,jm2),radswg(im2,jm2),swgclr(im2,jm2)
75        real albedo(im2,jm2),fdirpar(im2,jm2),fdifpar(im2,jm2)        real albedo(im2,jm2),fdirpar(im2,jm2),fdifpar(im2,jm2)
76        real osr(im2,jm2),osrclr(im2,jm2)        real osr(im2,jm2),osrclr(im2,jm2)
77        real tg0(im2,jm2),tg0c(im2,jm2),radlwg(im2,jm2),st4(im2,jm2)        real tg0(im2,jm2),radlwg(im2,jm2),st4(im2,jm2)
78        real dst4(im2,jm2),dlwdtg(im2,jm2),lwclr(im2,jm2)        real dst4(im2,jm2),dlwdtg(im2,jm2,Nrphys)
79        real rainlsp(im2,jm2),raincon(im2,jm2),snowfall(im2,jm2)        real rainlsp(im2,jm2),raincon(im2,jm2),snowfall(im2,jm2)
80        real cldtot_lw(im2,jm2,Nrphys),clras_lw(im2,jm2,Nrphys)        real cldtot_lw(im2,jm2,Nrphys),clras_lw(im2,jm2,Nrphys)
81        real cldlsp_lw(im2,jm2,Nrphys),lwlz(im2,jm2,Nrphys)        real cldlsp_lw(im2,jm2,Nrphys),lwlz(im2,jm2,Nrphys)
# Line 89  c Line 89  c
89        real gwet(im2,jm2),snow(im2,jm2)        real gwet(im2,jm2),snow(im2,jm2)
90    
91        integer i,j,L        integer i,j,L
92        real getcon, kappa, p0kappa        real getcon, kappa, p0kappa, s0, ra
93          real cosz(im2,jm2)
94    
95  C***********************************************************************  C***********************************************************************
96  C Unshadow input arrays (and make 'fizhi theta' from true theta)  C Unshadow input arrays (and make 'fizhi theta' from true theta)
# Line 97  C*************************************** Line 98  C***************************************
98    
99        kappa = getcon('KAPPA')        kappa = getcon('KAPPA')
100        p0kappa = 1000.0 ** kappa        p0kappa = 1000.0 ** kappa
101          S0 = getcon('S0')
102                
103        do L = 1,Nrphys        do L = 1,Nrphys
104        do j = jm1,jm2        do j = jm1,jm2
105        do i = im1,im2        do i = im1,im2
106         u(i,j,L) = uphys(i,j,L,bi,bj)         u(i,j,L) = uphys(i,j,L,bi,bj)
107         v(i,j,L) = vphys(i,j,L,bi,bj)         v(i,j,L) = vphys(i,j,L,bi,bj)
108         t(i,j,L) = thphys(i,j,L,bi,bj)         t(i,j,L) = thphys(i,j,L,bi,bj)/p0kappa
109         q(i,j,L,1) = sphys(i,j,L,bi,bj)         q(i,j,L,1) = sphys(i,j,L,bi,bj)
110        enddo        enddo
111        enddo        enddo
# Line 117  C*************************************** Line 119  C***************************************
119        enddo        enddo
120        enddo        enddo
121    
122          call astro ( nymd,nhms, xlats,xlons, im2*jm2, cosz,ra )
123          do j=jm1,jm2
124          do i=im1,im2
125           radswt(i,j) = S0*(1.0/ra**2)*cosz(i,j)
126          enddo
127          enddo
128    
129    
130        ptracer = 1        ptracer = 1
131        ntracer = 1        ntracer = 1
132    
133        call fizhi_driver(myid,im2,jm2,Nrphys,ptracer,ntracer,xlats,xlons,        call fizhi_driver(myid,im2,jm2,Nrphys,ptracer,ntracer,xlats,xlons,
134       . p,u,v,t,q,pl,ple,dpres,pkht,pkl,fracland,landtype,radswt,       . p,u,v,t,q,pl,ple,dpres,pkht,pkl,fracland(1,1,bi,bj),
135       . phis_var,tgz,sea_ice,       . landtype(1,1,bi,bj),radswt,
136       . nchp,chlat,chlon,igrd,nchpland,chfr,ityp,       . phis_var(1,1,bi,bj),tgz(1,1,bi,bj),sea_ice,
137       . tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,capac,snodep,       . nchp,chlat(1,bi,bj),chlon(1,bi,bj),igrd(1,bi,bj),nchpland,
138       . ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,       . chfr(1,bi,bj),ityp(1,bi,bj),
139       . albvisdr,albvisdf,albnirdr,albnirdf,emiss,alai,agrn,       . tcanopy(1,bi,bj),tdeep(1,bi,bj),ecanopy(1,bi,bj),
140       . qstr,o3,co2,cfc11,cfc12,cfc22,methane,n2o,       . swetshal(1,bi,bj),swetroot(1,bi,bj),swetdeep(1,bi,bj),
141         . capac(1,bi,bj),snodep(1,bi,bj),
142         . ctmt(1,bi,bj),xxmt(1,bi,bj),yymt(1,bi,bj),zetamt(1,bi,bj),
143         . xlmt(1,1,bi,bj),khmt(1,1,bi,bj),tke(1,1,bi,bj),
144         . albvisdr(1,bi,bj),albvisdf(1,bi,bj),albnirdr(1,bi,bj),
145         . albnirdf(1,bi,bj),emiss(1,bi,bj),alai(1,bi,bj),agrn(1,bi,bj),
146         . qstr(1,1,bi,bj),o3(1,1,bi,bj),co2,cfc11,cfc12,cfc22,methane,n2o,
147       . lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq,       . lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq,
148       . moistu,moistv,moistt,moistq,       . moistu,moistv,moistt,moistq,
149       . radswg,swgclr,albedo,fdirpar,fdifpar,osr,osrclr,tg0,tg0c,radlwg,       . radswg,swgclr,albedo,fdirpar,fdifpar,osr,osrclr,tg0,radlwg,
150       . st4,dst4,dlwdtg,lwclr,rainlsp,raincon,snowfall,iras,nlwcld,       . st4,dst4,dlwdtg,rainlsp,raincon,snowfall,iras,nlwcld,
151       . cldtot_lw,clras_lw,cldlsp_lw,nlwlz,lwlz,nswcld,cldtot_sw,       . cldtot_lw,clras_lw,cldlsp_lw,nlwlz,lwlz,nswcld,cldtot_sw,
152       . clras_sw,cldlsp_sw,nswlz,swlz,imstturbsw,imstturblw,qliqavesw,       . clras_sw,cldlsp_sw,nswlz,swlz,imstturbsw,imstturblw,qliqavesw,
153       . qliqavelw,fccavesw,fccavelw,qq,u2m,v2m,t2m,q2m,u10m,v10m,t10m,       . qliqavelw,fccavesw,fccavelw,qq,u2m,v2m,t2m,q2m,u10m,v10m,t10m,
154       . q10m,gwet,snow)       . q10m,gwet,snow)
155    
156          do L = 1,Nrphys
157          do j = jm1,jm2
158          do i = im1,im2
159           duphys(i,j,L,bi,bj) = moistu(i,j,L) + turbu(i,j,L)
160           dvphys(i,j,L,bi,bj) = moistv(i,j,L) + turbv(i,j,L)
161           dthphys(i,j,L,bi,bj) = ( ( moistt(i,j,L) + turbt(i,j,L) +
162         .           lwdt(i,j,L) + dlwdtg(i,j,L) * (tgz(i,j)-tg0(i,j)) +
163         .           swdt(i,j,L) * radswt(i,j) ) * p0kappa ) / p(i,j)
164           dsphys(i,j,L,bi,bj) = (moistq(i,j,L,1) + turbq(i,j,L,1))/p(i,j)
165          enddo
166          enddo
167          enddo
168    
169        return        return
170        end        end
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22