pkg/fizhi/fizhi_driver.F

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 C***********************************************************************
                0019 C  Purpose
                0020 C  -------
1662f365b2 Andr*0021 C     Driver for the FIZHI high-end Atmospheric Physics
                0022 C
45ad04df92 Jean*0023 C  Arguments  Description
1662f365b2 Andr*0024 C  ----------------------
45ad04df92 Jean*0025 C     nymd ..... Current YYMMDD
                0026 C     nhms ..... Current HHMMSS
1662f365b2 Andr*0027 C     fracland.. Land Fractions
                0028 C     landtype.. Land Vegetation Types
                0029 C     radswt ... Incident Solar Radiation
45ad04df92 Jean*0030 C
                0031 C***********************************************************************
e4ce4355da Jean*0032       IMPLICIT NONE
1662f365b2 Andr*0033
                0034 c Diagnostic Common
                0035 c -----------------
                0036
                0037 c Timers Common
                0038 c -------------
ed0b0d8f16 Andr*0039 #include "chronos.h"
1662f365b2 Andr*0040
                0041 c Input Parameters
                0042 c ----------------
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 c Local Variables
                0094 c ---------------
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 C     data pcheckpress/950.,750.,700.,400.,10./
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 C **********************************************************************
                0123 C ****                         Initialization                       ****
                0124 C **********************************************************************
                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 C Fill array of model levels closest to a given pressure value
                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 CCC   cumfric = .true.
689620ef36 Andr*0145       cumfric = .false.
                0146
45ad04df92 Jean*0147 C **********************************************************************
                0148 C ****                  Call Physics Mini-Drivers                   ****
                0149 C **********************************************************************
082e38725b Andr*0150
1662f365b2 Andr*0151 C SHORT WAVE RADIATION
                0152 C ====================
                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 C LONG WAVE RADIATION
                0167 C ===================
                0168       IF ( alarm('radlw') ) THEN
                0169
                0170 c Set Reference Ground Temperature
                0171 c --------------------------------
                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 C TURBULENCE
                0190 C ==========
                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 c Add Gravity-Wave Drag Tendency
                0207 c ------------------------------
45ad04df92 Jean*0208 C Comment this out for now
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 c Add Rayleigh Friction Damping Above 70 Km
                0215 c -----------------------------------------
                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 C Now Add Rayleigh Friction Tendencies to Turb Tendency
                0220
689620ef36 Andr*0221 C     do L=1,lm
                0222 C     do j=1,jm
                0223 C     do i=1,im
                0224 C      turbu(i,j,L) = turbu(i,j,L) + rfu(i,j,L)
                0225 C      turbv(i,j,L) = turbv(i,j,L) + rfv(i,j,L)
                0226 C      turbt(i,j,L) = turbt(i,j,L) + rft(i,j,L)
                0227 C     enddo
                0228 C     enddo
                0229 C     enddo
54afd28287 Andr*0230
1662f365b2 Andr*0231       endif
45ad04df92 Jean*0232
1662f365b2 Andr*0233 C MOIST PROCESSES
                0234 C ===============
                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