File indexing completed on 2024-05-11 05:10:30 UTC
view on githubraw file Latest commit 41c4545f on 2024-05-10 15:00:41 UTC
a456aa407c Andr*0001 #include "FIZHI_OPTIONS.h"
e4ce4355da Jean*0002 SUBROUTINE FIZHI_DRIVER (myid,im,jm,lm,bi,bj,ptracer,ntracer,
0003 & turbStart, xlats,xlons,
0004 & p,u,v,t,q,pl,ple,dpres,pkht,pkl,surfz,fracland,landtype,radswt,
0005 & phis_var,tgz,sea_ice,
0006 & nchp,chlat,chlon,igrd,nchptot,nchpland,chfr,ityp,
0007 & tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,capac,snodep,
0008 & ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
0009 & albvisdr,albvisdf,albnirdr,albnirdf,emiss,alai,agrn,
0010 & chemq,chemo3,co2,cfc11,cfc12,cfc22,methane,n2o,
0011 & lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq,
0012 & moistu,moistv,moistt,moistq,
0013 & radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg,lwgclr,
0014 & st4,dst4,dlwdtg,rainlsp,raincon,snowfall,iras,nlwcld,
0015 & cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,nswcld,cldtot_sw,
0016 & cldras_sw,cldlsp_sw,nswlz,swlz,imstturbsw,imstturblw,qliqavesw,
0017 & qliqavelw,fccavesw,fccavelw,qq)
45ad04df92 Jean*0018
0019
0020
1662f365b2 Andr*0021
0022
45ad04df92 Jean*0023
1662f365b2 Andr*0024
45ad04df92 Jean*0025
0026
1662f365b2 Andr*0027
0028
0029
45ad04df92 Jean*0030
0031
e4ce4355da Jean*0032 IMPLICIT NONE
1662f365b2 Andr*0033
0034
0035
0036
0037
0038
ed0b0d8f16 Andr*0039 #include "chronos.h"
1662f365b2 Andr*0040
0041
0042
e4ce4355da Jean*0043 INTEGER myid,im,jm,lm,bi,bj,ptracer,ntracer
0044 LOGICAL turbStart
0045 INTEGER nchp,igrd(nchp),nchptot,nchpland,ityp(nchp)
0046 INTEGER iras,nlwcld,nlwlz,nswcld,nswlz
0047 INTEGER imstturbsw,imstturblw
1662f365b2 Andr*0048
a456aa407c Andr*0049 _RL xlats(im,jm), xlons(im,jm)
0050 _RL p(im,jm)
0051 _RL u(im,jm,lm),v(im,jm,lm),t(im,jm,lm)
0052 _RL q(im,jm,lm,ntracer)
0053 _RL pl(im,jm,lm),ple(im,jm,lm+1),dpres(im,jm,lm)
5017e458a8 Andr*0054 _RL pkht(im,jm,lm+1)
a456aa407c Andr*0055 _RL pkl(im,jm,lm)
3b54a39eaf Andr*0056 _RL surfz(im,jm)
9524fe64b5 Andr*0057 _RL radswt(im,jm), fracland(im,jm)
e4ce4355da Jean*0058 INTEGER landtype(im,jm)
a456aa407c Andr*0059 _RL phis_var(im,jm), sea_ice(im,jm)
0060 _RL chlat(nchp),chlon(nchp),chfr(nchp)
0061 _RL tcanopy(nchp),tdeep(nchp),ecanopy(nchp),swetshal(nchp)
0062 _RL swetroot(nchp),swetdeep(nchp),capac(nchp),snodep(nchp)
0063 _RL ctmt(nchp),xxmt(nchp),yymt(nchp),zetamt(nchp)
0064 _RL xlmt(nchp,lm),khmt(nchp,lm),tke(nchp,lm)
0065 _RL co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)
0066 _RL lwdt(im,jm,lm),lwdtclr(im,jm,lm)
0067 _RL swdt(im,jm,lm),swdtclr(im,jm,lm)
0068 _RL turbu(im,jm,lm),turbv(im,jm,lm),turbt(im,jm,lm)
8abd7ee9c6 Andr*0069 _RL turbq(im,jm,lm,ntracer)
a456aa407c Andr*0070 _RL moistu(im,jm,lm),moistv(im,jm,lm),moistt(im,jm,lm)
8abd7ee9c6 Andr*0071 _RL moistq(im,jm,lm,ntracer)
a456aa407c Andr*0072 _RL chemo3(im,jm,lm),chemq(im,jm,lm)
0073 _RL albvisdr(im,jm),albvisdf(im,jm),albnirdr(im,jm)
032fb71841 Andr*0074 _RL albnirdf(im,jm),emiss(im,jm,10)
a456aa407c Andr*0075 _RL alai(nchp),agrn(nchp)
0076 _RL radswg(im,jm),swgclr(im,jm)
0077 _RL fdirpar(im,jm),fdifpar(im,jm),osr(im,jm),osrclr(im,jm)
0078 _RL tg0(im,jm),radlwg(im,jm),lwgclr(im,jm),st4(im,jm)
0079 _RL dst4(im,jm)
0080 _RL dlwdtg(im,jm,lm)
0081 _RL rainlsp(im,jm),raincon(im,jm),snowfall(im,jm)
0082 _RL cldtot_lw(im,jm,lm),cldras_lw(im,jm,lm)
0083 _RL cldlsp_lw(im,jm,lm)
0084 _RL lwlz(im,jm,lm)
0085 _RL cldtot_sw(im,jm,lm),cldras_sw(im,jm,lm)
0086 _RL cldlsp_sw(im,jm,lm)
0087 _RL swlz(im,jm,lm)
0088 _RL qliqavesw(im,jm,lm),qliqavelw(im,jm,lm)
0089 _RL fccavesw(im,jm,lm),fccavelw(im,jm,lm)
0090 _RL qq(im,jm,lm)
0091 _RL tgz(im,jm)
1662f365b2 Andr*0092
0093
0094
54afd28287 Andr*0095 _RL rfu(im,jm,lm),rfv(im,jm,lm),rft(im,jm,lm)
e4ce4355da Jean*0096 LOGICAL alarm
0097 EXTERNAL alarm
0098 INTEGER numpcheck
0099 PARAMETER (numpcheck = 5)
0100 INTEGER pchecklevs(numpcheck)
a456aa407c Andr*0101 _RL pcheckpress(numpcheck)
c74d45a9d3 Andr*0102
f1fd7b7aa2 Andr*0103 data pcheckpress/950.,850.,700.,400.,10./
1662f365b2 Andr*0104
e4ce4355da Jean*0105 INTEGER low_level,mid_level,nltop,nsubmin,nsubmax,Lup
0106 INTEGER ndmoist,ndturb,ndlw,ndsw
0107 INTEGER istrip,npcs
0108 INTEGER i,j
0109 INTEGER ndpnt
45ad04df92 Jean*0110 INTEGER ndum0, ndum1, ndum2
a456aa407c Andr*0111 _RL akap,getcon
0112 _RL ptop
e4ce4355da Jean*0113 LOGICAL lpnt,cumfric
0114 INTEGER imglobal
1662f365b2 Andr*0115
046c3794c1 Andr*0116 istrip = im*jm
0117 npcs = 1
1662f365b2 Andr*0118
0119 ptop = 0.
0120 akap = getcon('KAPPA')
0121
45ad04df92 Jean*0122
0123
0124
0125 call get_alarm ( 'radlw',ndum0,ndum1, ndlw ,ndum2 )
0126 call get_alarm ( 'radsw',ndum0,ndum1, ndsw ,ndum2 )
0127 call get_alarm ( 'turb' ,ndum0,ndum1, ndturb ,ndum2 )
0128 call get_alarm ( 'moist',ndum0,ndum1, ndmoist,ndum2 )
4c46c31842 Andr*0129
45ad04df92 Jean*0130 call get_alarm ( 'pnt' ,ndum0,ndum1, ndpnt ,ndum2 )
1662f365b2 Andr*0131 lpnt = ndpnt.ne.0
0132
26892788b0 Andr*0133
0134
0135 call getpwhere(myid,numpcheck,pcheckpress,pchecklevs)
046c3794c1 Andr*0136
d2aaec7e02 Andr*0137 low_level = pchecklevs(3)
0138 mid_level = pchecklevs(4)
0139 nltop = pchecklevs(5)
0140 nsubmin = pchecklevs(1)
0141 nsubmax = pchecklevs(2)
0142 Lup = pchecklevs(3)
1662f365b2 Andr*0143
0b2d323985 Andr*0144
689620ef36 Andr*0145 cumfric = .false.
0146
45ad04df92 Jean*0147
0148
0149
082e38725b Andr*0150
1662f365b2 Andr*0151
0152
0153 IF ( alarm('radsw') ) THEN
0154
180c87c6d9 Andr*0155 call swrio ( nymd,nhms,bi,bj,ndsw,myid,istrip,npcs,
e4ce4355da Jean*0156 & low_level,mid_level,im,jm,lm,
0157 & p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
0158 & albvisdr,albvisdf,albnirdr,albnirdf,swdt,swdtclr,
0159 & radswg,swgclr,fdifpar,fdirpar,osr,osrclr,
0160 & ptop,nswcld,cldtot_sw,cldras_sw,nswlz,swlz,
0161 & .false.,imstturbsw,qliqavesw,
0162 & fccavesw,landtype,xlats,xlons )
1662f365b2 Andr*0163
0164 ENDIF
45ad04df92 Jean*0165
1662f365b2 Andr*0166
0167
0168 IF ( alarm('radlw') ) THEN
0169
0170
0171
0172 do j=1,jm
0173 do i=1,im
0174 tg0(i,j) = tgz(i,j)
0175 enddo
0176 enddo
0177
8b150b4af9 Andr*0178 call lwrio ( nymd,nhms,bi,bj,myid,istrip,npcs,
e4ce4355da Jean*0179 & low_level,mid_level,im,jm,lm,
0180 & p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
0181 & cfc11,cfc12,cfc22,methane,n2o,emiss,tgz,radlwg,st4,dst4,
0182 & lwdt,dlwdtg,lwdtclr,lwgclr,
0183 & nlwcld,cldtot_lw,cldras_lw,nlwlz,lwlz,
0184 & .false.,imstturblw,qliqavelw,
0185 & fccavelw,landtype )
1662f365b2 Andr*0186
0187 ENDIF
046c3794c1 Andr*0188
1662f365b2 Andr*0189
0190
0191 IF ( alarm('turb') ) THEN
0192
e4ce4355da Jean*0193 call turbio (im,jm,lm,istrip,nymd,nhms,bi,bj,
0194 & turbStart, ndturb,nltop,
0195 & ptop,p,u,v,t,q,ntracer,ptracer,pl,ple,dpres,pkht,pkl,
0196 & ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
0197 & tgz,fracland,landtype,
0198 & tcanopy,ecanopy,tdeep,swetshal,swetroot,swetdeep,snodep,capac,
0199 & nchp,nchptot,nchpland,chfr,chlat,chlon,igrd,ityp,
0200 & alai,agrn,sea_ice,lpnt,
0201 & turbu,turbv,turbt,turbq,radlwg,st4,dst4,radswg,radswt,
0202 & fdifpar,fdirpar,rainlsp,raincon,snowfall,tg0,
0203 & imstturblw,imstturbsw,qliqavelw,qliqavesw,fccavelw,fccavesw,qq,
0204 & myid)
1662f365b2 Andr*0205
0206
0207
45ad04df92 Jean*0208
1662f365b2 Andr*0209
898d6c766c Andr*0210 imglobal = 128
0211 call gwdrag (myid,p,pl,ple,dpres,pkl,u,v,t,q,phis_var,
e4ce4355da Jean*0212 & turbu,turbv,turbt,im,jm,lm,bi,bj,istrip,npcs,imglobal)
1662f365b2 Andr*0213
54afd28287 Andr*0214
0215
0216
0217 call rayleigh(myid,pl,pkl,pkht,surfz,u,v,t,q,im,jm,lm,
e4ce4355da Jean*0218 & bi,bj,rfu,rfv,rft)
54afd28287 Andr*0219
0220
689620ef36 Andr*0221
0222
0223
0224
0225
0226
0227
0228
0229
54afd28287 Andr*0230
1662f365b2 Andr*0231 endif
45ad04df92 Jean*0232
1662f365b2 Andr*0233
0234
0235 if ( alarm('moist') ) then
0236 call moistio (ndmoist,istrip,npcs,
e4ce4355da Jean*0237 & low_level,mid_level,nltop,nsubmin,nsubmax,Lup,
0238 & p,pl,ple,dpres,pkht,pkl,u,v,t,q,bi,bj,ntracer,ptracer,qq,
0239 & moistu,moistv,moistt,moistq,cumfric,im,jm,lm,ptop,iras,
0240 & rainlsp,raincon,snowfall,
0241 & nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
0242 & nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
0243 & .false.,myid)
1662f365b2 Andr*0244 endif
0245
0246 return
0247 end