pkg/fizhi/fizhi_driver.F

C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_driver.F,v 1.27 2004/10/07 03:20:56 molod Exp $
C $Name:  $
                                                                                 
#include "FIZHI_OPTIONS.h"
      subroutine fizhi_driver (myid,im,jm,lm,bi,bj,ptracer,ntracer,
     . xlats,xlons,
     . p,u,v,t,q,pl,ple,dpres,pkht,pkl,fracland,landtype,radswt,
     . phis_var,tgz,sea_ice,
     . nchp,chlat,chlon,igrd,nchptot,nchpland,chfr,ityp,
     . tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,capac,snodep,
     . ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
     . albvisdr,albvisdf,albnirdr,albnirdf,emiss,alai,agrn,
     . chemq,chemo3,co2,cfc11,cfc12,cfc22,methane,n2o,
     . lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq,
     . moistu,moistv,moistt,moistq,
     . radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg,lwgclr,
     . st4,dst4,dlwdtg,rainlsp,raincon,snowfall,iras,nlwcld,
     . cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,nswcld,cldtot_sw,
     . cldras_sw,cldlsp_sw,nswlz,swlz,imstturbsw,imstturblw,qliqavesw,
     . qliqavelw,fccavesw,fccavelw,qq)
C***********************************************************************        
C  Purpose                                                                      
C  -------                                                                      
C     Driver for the FIZHI high-end Atmospheric Physics
C
C  Arguments  Description                                                      
C  ----------------------
C     nymd ..... Current YYMMDD                                                 
C     nhms ..... Current HHMMSS                                                 
C     fracland.. Land Fractions
C     landtype.. Land Vegetation Types
C     radswt ... Incident Solar Radiation
C                                                                               
C***********************************************************************        
      implicit none

c Diagnostic Common
c -----------------
#ifdef ALLOW_DIAGNOSTICS
#include "SIZE.h"
#include "diagnostics_SIZE.h"
#include "diagnostics.h"
#endif

c Timers Common
c -------------
#include "chronos.h"

c Input Parameters
c ----------------
      integer myid,im,jm,lm,bi,bj,ptracer,ntracer
      integer nchp,igrd(nchp),nchptot,nchpland,ityp(nchp)
      integer iras,nlwcld,nlwlz,nswcld,nswlz
      integer imstturbsw,imstturblw

      _RL xlats(im,jm), xlons(im,jm)
      _RL p(im,jm)
      _RL u(im,jm,lm),v(im,jm,lm),t(im,jm,lm)
      _RL q(im,jm,lm,ntracer)
      _RL pl(im,jm,lm),ple(im,jm,lm+1),dpres(im,jm,lm)
      _RL pkht(im,jm,lm)
      _RL pkl(im,jm,lm)
      _RL radswt(im,jm), fracland(im,jm)
      integer landtype(im,jm)
      _RL phis_var(im,jm), sea_ice(im,jm)
      _RL chlat(nchp),chlon(nchp),chfr(nchp)
      _RL tcanopy(nchp),tdeep(nchp),ecanopy(nchp),swetshal(nchp)
      _RL swetroot(nchp),swetdeep(nchp),capac(nchp),snodep(nchp)
      _RL ctmt(nchp),xxmt(nchp),yymt(nchp),zetamt(nchp)
      _RL xlmt(nchp,lm),khmt(nchp,lm),tke(nchp,lm)
      _RL co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)
      _RL lwdt(im,jm,lm),lwdtclr(im,jm,lm)
      _RL swdt(im,jm,lm),swdtclr(im,jm,lm)
      _RL turbu(im,jm,lm),turbv(im,jm,lm),turbt(im,jm,lm)
      _RL turbq(im,jm,lm,ntracer)
      _RL moistu(im,jm,lm),moistv(im,jm,lm),moistt(im,jm,lm)
      _RL moistq(im,jm,lm,ntracer)
      _RL chemo3(im,jm,lm),chemq(im,jm,lm)
      _RL albvisdr(im,jm),albvisdf(im,jm),albnirdr(im,jm)
      _RL albnirdf(im,jm),emiss(im,jm,10)
      _RL alai(nchp),agrn(nchp)
      _RL radswg(im,jm),swgclr(im,jm)
      _RL fdirpar(im,jm),fdifpar(im,jm),osr(im,jm),osrclr(im,jm)
      _RL tg0(im,jm),radlwg(im,jm),lwgclr(im,jm),st4(im,jm)
      _RL dst4(im,jm)
      _RL dlwdtg(im,jm,lm)
      _RL rainlsp(im,jm),raincon(im,jm),snowfall(im,jm)
      _RL cldtot_lw(im,jm,lm),cldras_lw(im,jm,lm)
      _RL cldlsp_lw(im,jm,lm)
      _RL lwlz(im,jm,lm)
      _RL cldtot_sw(im,jm,lm),cldras_sw(im,jm,lm)
      _RL cldlsp_sw(im,jm,lm)
      _RL swlz(im,jm,lm)
      _RL qliqavesw(im,jm,lm),qliqavelw(im,jm,lm)
      _RL fccavesw(im,jm,lm),fccavelw(im,jm,lm)
      _RL qq(im,jm,lm)
      _RL tgz(im,jm)

c Local Variables
c ---------------
      logical     alarm
      external    alarm
      integer numpcheck
      parameter (numpcheck = 5)
      integer pchecklevs(numpcheck)
      _RL pcheckpress(numpcheck)
      data pcheckpress/950.,750.,700.,400.,10./

      integer low_level,mid_level,nltop,nsubmin,nsubmax,Lup
      integer ndmoist,ndturb,ndlw,ndsw
      integer istrip,npcs
      integer i,j,L
      integer ndum,ndpnt
      _RL akap,getcon
      _RL ptop
      logical lpnt

      istrip = im*jm
      npcs   = 1

      ptop   =  0.
      akap = getcon('KAPPA')

C **********************************************************************        
C ****                         Initialization                       ****        
C **********************************************************************        
      call get_alarm ( 'radlw',ndum,ndum,ndlw   ,ndum )
      call get_alarm ( 'radsw',ndum,ndum,ndsw   ,ndum )
      call get_alarm ( 'turb' ,ndum,ndum,ndturb ,ndum )
      call get_alarm ( 'moist',ndum,ndum,ndmoist,ndum )

      call get_alarm ( 'pnt',ndum,ndum,ndpnt,ndum )
      lpnt = ndpnt.ne.0

C Fill array of model levels closest to a given pressure value

      call getpwhere(myid,numpcheck,pcheckpress,pchecklevs)

      low_level = pchecklevs(3)
      mid_level = pchecklevs(4)
      nltop = pchecklevs(5)
      nsubmin = pchecklevs(1)
      nsubmax = pchecklevs(2)
      Lup = pchecklevs(3)

C **********************************************************************        
C ****                  Call Physics Mini-Drivers                   ****        
C **********************************************************************        

C SHORT WAVE RADIATION
C ====================
      IF ( alarm('radsw') ) THEN

      call swrio ( nymd,nhms,bi,bj,ndsw,myid,istrip,npcs,
     .   low_level,mid_level,im,jm,lm,
     .   p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
     .   albvisdr,albvisdf,albnirdr,albnirdf,swdt,swdtclr,
     .   radswg,swgclr,fdifpar,fdirpar,osr,osrclr,
     .   ptop,nswcld,cldtot_sw,cldras_sw,nswlz,swlz,
     .   .false.,imstturbsw,qliqavesw,
     .   fccavesw,landtype,xlats,xlons )

      ENDIF
                                                                                
C LONG WAVE RADIATION
C ===================
      IF ( alarm('radlw') ) THEN

c Set Reference Ground Temperature
c --------------------------------
      do j=1,jm
      do i=1,im
      tg0(i,j) = tgz(i,j)
      enddo
      enddo

      call lwrio ( nymd,nhms,bi,bj,istrip,npcs,
     .   low_level,mid_level,im,jm,lm,
     .   p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
     .   cfc11,cfc12,cfc22,methane,n2o,emiss,tgz,radlwg,st4,dst4,
     .   lwdt,dlwdtg,lwdtclr,lwgclr,
     .   nlwcld,cldtot_lw,cldras_lw,nlwlz,lwlz,
     .   .false.,imstturblw,qliqavelw,
     .   fccavelw,landtype )

      ENDIF

C TURBULENCE
C ==========
      IF ( alarm('turb') ) THEN

      call turbio (im,jm,lm,istrip,nymd,nhms,bi,bj,ndturb,
     .  ptop,p,u,v,t,q,ntracer,ptracer,pl,ple,dpres,pkht,pkl,
     .  ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
     .  tgz,fracland,landtype,
     .  tcanopy,ecanopy,tdeep,swetshal,swetroot,swetdeep,snodep,capac,
     .  nchp,nchptot,nchpland,chfr,chlat,chlon,igrd,ityp,
     .  alai,agrn,sea_ice,lpnt,
     .  turbu,turbv,turbt,turbq,radlwg,st4,dst4,radswg,radswt,
     .  fdifpar,fdirpar,rainlsp,raincon,snowfall,tg0,
     .  imstturblw,imstturbsw,qliqavelw,qliqavesw,fccavelw,fccavesw,qq,
     .  myid)

c Add Gravity-Wave Drag Tendency
c ------------------------------
C Comment this out for now - run tropospheric resolutions only.
C Need to see how to get zonal wavelengths on the cube.

c     call gwdrag (myid,p,pl,ple,dpres,pkht,pkl,u,v,t,q,phis_var,
c    .   turbu,turbv,turbt,im,jm,lm,ptop,istrip,npcs,
c    .   imglobal)

      endif
                                                                                
C MOIST PROCESSES
C ===============
      if ( alarm('moist') ) then
      call moistio (ndmoist,istrip,npcs,
     .    low_level,mid_level,nltop,nsubmin,nsubmax,Lup,
     .    p,pl,ple,dpres,pkht,pkl,t,q,bi,bj,ntracer,ptracer,qq,
     .    moistu,moistv,moistt,moistq,im,jm,lm,ptop,iras,
     .    rainlsp,raincon,snowfall,
     .    nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
     .    nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
     .              .false.,myid)
      endif

      return
      end
1	molod	1.28	C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_driver.F,v 1.27 2004/10/07 03:20:56 molod Exp $
2	molod	1.1	C $Name: $
3
4	molod	1.13	#include "FIZHI_OPTIONS.h"
5	molod	1.5	subroutine fizhi_driver (myid,im,jm,lm,bi,bj,ptracer,ntracer,
6	molod	1.2	. xlats,xlons,
7	molod	1.1	. p,u,v,t,q,pl,ple,dpres,pkht,pkl,fracland,landtype,radswt,
8	molod	1.2	. phis_var,tgz,sea_ice,
9	molod	1.12	. nchp,chlat,chlon,igrd,nchptot,nchpland,chfr,ityp,
10	molod	1.1	. tcanopy,tdeep,ecanopy,swetshal,swetroot,swetdeep,capac,snodep,
11			. ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
12			. albvisdr,albvisdf,albnirdr,albnirdf,emiss,alai,agrn,
13	molod	1.2	. chemq,chemo3,co2,cfc11,cfc12,cfc22,methane,n2o,
14	molod	1.1	. lwdt,lwdtclr,swdt,swdtclr,turbu,turbv,turbt,turbq,
15			. moistu,moistv,moistt,moistq,
16	molod	1.11	. radswg,swgclr,fdirpar,fdifpar,osr,osrclr,tg0,radlwg,lwgclr,
17	molod	1.3	. st4,dst4,dlwdtg,rainlsp,raincon,snowfall,iras,nlwcld,
18	molod	1.11	. cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,nswcld,cldtot_sw,
19			. cldras_sw,cldlsp_sw,nswlz,swlz,imstturbsw,imstturblw,qliqavesw,
20	molod	1.4	. qliqavelw,fccavesw,fccavelw,qq)
21	molod	1.1	C***********************************************************************
22			C Purpose
23			C -------
24			C Driver for the FIZHI high-end Atmospheric Physics
25			C
26			C Arguments Description
27			C ----------------------
28			C nymd ..... Current YYMMDD
29			C nhms ..... Current HHMMSS
30			C fracland.. Land Fractions
31			C landtype.. Land Vegetation Types
32			C radswt ... Incident Solar Radiation
33			C
34			C***********************************************************************
35			implicit none
36
37			c Diagnostic Common
38			c -----------------
39			#ifdef ALLOW_DIAGNOSTICS
40	molod	1.14	#include "SIZE.h"
41			#include "diagnostics_SIZE.h"
42			#include "diagnostics.h"
43	molod	1.1	#endif
44
45			c Timers Common
46			c -------------
47	molod	1.11	#include "chronos.h"
48	molod	1.1
49			c Input Parameters
50			c ----------------
51	molod	1.5	integer myid,im,jm,lm,bi,bj,ptracer,ntracer
52	molod	1.12	integer nchp,igrd(nchp),nchptot,nchpland,ityp(nchp)
53	molod	1.1	integer iras,nlwcld,nlwlz,nswcld,nswlz
54			integer imstturbsw,imstturblw
55
56	molod	1.13	_RL xlats(im,jm), xlons(im,jm)
57			_RL p(im,jm)
58			_RL u(im,jm,lm),v(im,jm,lm),t(im,jm,lm)
59			_RL q(im,jm,lm,ntracer)
60			_RL pl(im,jm,lm),ple(im,jm,lm+1),dpres(im,jm,lm)
61			_RL pkht(im,jm,lm)
62			_RL pkl(im,jm,lm)
63	molod	1.16	_RL radswt(im,jm), fracland(im,jm)
64			integer landtype(im,jm)
65	molod	1.13	_RL phis_var(im,jm), sea_ice(im,jm)
66			_RL chlat(nchp),chlon(nchp),chfr(nchp)
67			_RL tcanopy(nchp),tdeep(nchp),ecanopy(nchp),swetshal(nchp)
68			_RL swetroot(nchp),swetdeep(nchp),capac(nchp),snodep(nchp)
69			_RL ctmt(nchp),xxmt(nchp),yymt(nchp),zetamt(nchp)
70			_RL xlmt(nchp,lm),khmt(nchp,lm),tke(nchp,lm)
71			_RL co2,cfc11,cfc12,cfc22,methane(lm),n2o(lm)
72			_RL lwdt(im,jm,lm),lwdtclr(im,jm,lm)
73			_RL swdt(im,jm,lm),swdtclr(im,jm,lm)
74			_RL turbu(im,jm,lm),turbv(im,jm,lm),turbt(im,jm,lm)
75	molod	1.24	_RL turbq(im,jm,lm,ntracer)
76	molod	1.13	_RL moistu(im,jm,lm),moistv(im,jm,lm),moistt(im,jm,lm)
77	molod	1.24	_RL moistq(im,jm,lm,ntracer)
78	molod	1.13	_RL chemo3(im,jm,lm),chemq(im,jm,lm)
79			_RL albvisdr(im,jm),albvisdf(im,jm),albnirdr(im,jm)
80	molod	1.23	_RL albnirdf(im,jm),emiss(im,jm,10)
81	molod	1.13	_RL alai(nchp),agrn(nchp)
82			_RL radswg(im,jm),swgclr(im,jm)
83			_RL fdirpar(im,jm),fdifpar(im,jm),osr(im,jm),osrclr(im,jm)
84			_RL tg0(im,jm),radlwg(im,jm),lwgclr(im,jm),st4(im,jm)
85			_RL dst4(im,jm)
86			_RL dlwdtg(im,jm,lm)
87			_RL rainlsp(im,jm),raincon(im,jm),snowfall(im,jm)
88			_RL cldtot_lw(im,jm,lm),cldras_lw(im,jm,lm)
89			_RL cldlsp_lw(im,jm,lm)
90			_RL lwlz(im,jm,lm)
91			_RL cldtot_sw(im,jm,lm),cldras_sw(im,jm,lm)
92			_RL cldlsp_sw(im,jm,lm)
93			_RL swlz(im,jm,lm)
94			_RL qliqavesw(im,jm,lm),qliqavelw(im,jm,lm)
95			_RL fccavesw(im,jm,lm),fccavelw(im,jm,lm)
96			_RL qq(im,jm,lm)
97			_RL tgz(im,jm)
98	molod	1.1
99			c Local Variables
100			c ---------------
101			logical alarm
102			external alarm
103	molod	1.7	integer numpcheck
104			parameter (numpcheck = 5)
105			integer pchecklevs(numpcheck)
106	molod	1.13	_RL pcheckpress(numpcheck)
107	molod	1.7	data pcheckpress/950.,750.,700.,400.,10./
108	molod	1.1
109	molod	1.8	integer low_level,mid_level,nltop,nsubmin,nsubmax,Lup
110	molod	1.2	integer ndmoist,ndturb,ndlw,ndsw
111	molod	1.1	integer istrip,npcs
112	molod	1.17	integer i,j,L
113	molod	1.1	integer ndum,ndpnt
114	molod	1.13	_RL akap,getcon
115			_RL ptop
116	molod	1.1	logical lpnt
117
118	molod	1.15	istrip = im*jm
119			npcs = 1
120	molod	1.1
121			ptop = 0.
122			akap = getcon('KAPPA')
123
124			C **********************************************************************
125			C ** Initialization **
126			C **********************************************************************
127	molod	1.2	call get_alarm ( 'radlw',ndum,ndum,ndlw ,ndum )
128			call get_alarm ( 'radsw',ndum,ndum,ndsw ,ndum )
129			call get_alarm ( 'turb' ,ndum,ndum,ndturb ,ndum )
130			call get_alarm ( 'moist',ndum,ndum,ndmoist,ndum )
131
132	molod	1.1	call get_alarm ( 'pnt',ndum,ndum,ndpnt,ndum )
133			lpnt = ndpnt.ne.0
134
135	molod	1.7	C Fill array of model levels closest to a given pressure value
136
137			call getpwhere(myid,numpcheck,pcheckpress,pchecklevs)
138	molod	1.15
139	molod	1.8	low_level = pchecklevs(3)
140			mid_level = pchecklevs(4)
141			nltop = pchecklevs(5)
142			nsubmin = pchecklevs(1)
143			nsubmax = pchecklevs(2)
144			Lup = pchecklevs(3)
145	molod	1.1
146			C **********************************************************************
147			C ** Call Physics Mini-Drivers **
148			C **********************************************************************
149	molod	1.17
150	molod	1.1	C SHORT WAVE RADIATION
151			C ====================
152			IF ( alarm('radsw') ) THEN
153
154	molod	1.5	call swrio ( nymd,nhms,bi,bj,ndsw,myid,istrip,npcs,
155	molod	1.17	. low_level,mid_level,im,jm,lm,
156	molod	1.1	. p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
157			. albvisdr,albvisdf,albnirdr,albnirdf,swdt,swdtclr,
158	molod	1.17	. radswg,swgclr,fdifpar,fdirpar,osr,osrclr,
159	molod	1.1	. ptop,nswcld,cldtot_sw,cldras_sw,nswlz,swlz,
160			. .false.,imstturbsw,qliqavesw,
161			. fccavesw,landtype,xlats,xlons )
162
163			ENDIF
164
165			C LONG WAVE RADIATION
166			C ===================
167			IF ( alarm('radlw') ) THEN
168
169			c Set Reference Ground Temperature
170			c --------------------------------
171			do j=1,jm
172			do i=1,im
173			tg0(i,j) = tgz(i,j)
174			enddo
175			enddo
176
177	molod	1.5	call lwrio ( nymd,nhms,bi,bj,istrip,npcs,
178	molod	1.17	. low_level,mid_level,im,jm,lm,
179	molod	1.15	. p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,
180	molod	1.1	. cfc11,cfc12,cfc22,methane,n2o,emiss,tgz,radlwg,st4,dst4,
181	molod	1.23	. lwdt,dlwdtg,lwdtclr,lwgclr,
182	molod	1.1	. nlwcld,cldtot_lw,cldras_lw,nlwlz,lwlz,
183			. .false.,imstturblw,qliqavelw,
184			. fccavelw,landtype )
185
186			ENDIF
187	molod	1.15
188	molod	1.1	C TURBULENCE
189			C ==========
190			IF ( alarm('turb') ) THEN
191	molod	1.20
192	molod	1.21	call turbio (im,jm,lm,istrip,nymd,nhms,bi,bj,ndturb,
193	molod	1.19	. ptop,p,u,v,t,q,ntracer,ptracer,pl,ple,dpres,pkht,pkl,
194			. ctmt,xxmt,yymt,zetamt,xlmt,khmt,tke,
195			. tgz,fracland,landtype,
196			. tcanopy,ecanopy,tdeep,swetshal,swetroot,swetdeep,snodep,capac,
197			. nchp,nchptot,nchpland,chfr,chlat,chlon,igrd,ityp,
198			. alai,agrn,sea_ice,lpnt,
199			. turbu,turbv,turbt,turbq,radlwg,st4,dst4,radswg,radswt,
200			. fdifpar,fdirpar,rainlsp,raincon,snowfall,tg0,
201			. imstturblw,imstturbsw,qliqavelw,qliqavesw,fccavelw,fccavesw,qq,
202			. myid)
203	molod	1.1
204			c Add Gravity-Wave Drag Tendency
205			c ------------------------------
206			C Comment this out for now - run tropospheric resolutions only.
207			C Need to see how to get zonal wavelengths on the cube.
208
209			c call gwdrag (myid,p,pl,ple,dpres,pkht,pkl,u,v,t,q,phis_var,
210			c . turbu,turbv,turbt,im,jm,lm,ptop,istrip,npcs,
211			c . imglobal)
212	molod	1.17
213	molod	1.1	endif
214
215			C MOIST PROCESSES
216			C ===============
217			if ( alarm('moist') ) then
218			call moistio (ndmoist,istrip,npcs,
219	molod	1.8	. low_level,mid_level,nltop,nsubmin,nsubmax,Lup,
220	molod	1.5	. p,pl,ple,dpres,pkht,pkl,t,q,bi,bj,ntracer,ptracer,qq,
221	molod	1.1	. moistu,moistv,moistt,moistq,im,jm,lm,ptop,iras,
222	molod	1.11	. rainlsp,raincon,snowfall,
223	molod	1.1	. nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
224			. nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
225			. .false.,myid)
226			endif
227
228			return
229			end