11 subroutine gfs_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntrac, ntcw, ntiw, ntclamt, &
12 ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, ntccn, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, &
13 imp_physics_nssl, nssl_invertccn, nssl_ccn_on, &
14 imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi, dtidx, dtend,&
15 index_of_process_conv_trans, gq0, clw, prsl, save_tcp, con_rd, con_eps, nssl_cccn, nwfa, spechum, ldiag3d, &
16 qdiag3d, save_lnc, save_inc, ntk, ntke, otsptflag, errmsg, errflg)
25 logical,
intent(in) :: otsptflag(:)
26 integer,
intent(in ) :: im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, &
27 ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, ntccn, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, &
28 imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_nssl
30 logical,
intent(in) :: ltaerosol, convert_dry_rho
31 logical,
intent(in) :: nssl_ccn_on, nssl_invertccn
33 real(kind=kind_phys),
intent(in ) :: con_pi, dtf
34 real(kind=kind_phys),
intent(in ),
dimension(:,:) :: save_qc
36 real(kind=kind_phys),
intent(in ),
dimension(:,:) :: save_qi, save_lnc, save_inc
39 logical,
intent(in) :: ldiag3d, qdiag3d
40 real(kind=kind_phys),
dimension(:,:,:),
intent(inout),
optional :: dtend
41 integer,
dimension(:,:),
intent(in) :: dtidx
42 integer,
intent(in) :: index_of_process_conv_trans,ntk,ntke
44 real(kind=kind_phys),
dimension(:,:,:),
intent(inout) :: gq0
45 real(kind=kind_phys),
dimension(:,:,:),
intent(inout) :: clw
46 real(kind=kind_phys),
dimension(:,:),
intent(in) :: prsl
47 real(kind=kind_phys),
intent(in) :: con_rd, con_eps, nssl_cccn
48 real(kind=kind_phys),
dimension(:,:),
intent(in),
optional :: nwfa
49 real(kind=kind_phys),
dimension(:,:),
intent(in) :: save_tcp
50 real(kind=kind_phys),
dimension(:,:),
intent(in) :: spechum
52 character(len=*),
intent( out) :: errmsg
53 integer,
intent( out) :: errflg
56 real(kind=kind_phys),
parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys
57 integer :: i,k,n,tracers,idtend
58 real(kind=kind_phys) :: liqm, icem, xccn, xcwmas, xccw, xcimas, qccn
60 real(kind=kind_phys) :: rho, orho
61 real(kind=kind_phys),
dimension(im,levs) :: qv_mp
62 real(kind=kind_phys),
dimension(im,levs) :: qc_mp
63 real(kind=kind_phys),
dimension(im,levs) :: qi_mp
64 real(kind=kind_phys),
dimension(im,levs) :: nc_mp
65 real(kind=kind_phys),
dimension(im,levs) :: ni_mp
81 if (clw(i,k,2) <= -999.0) clw(i,k,2) = 0.0
86 if(ntk>0 .and. ntk<=
size(clw,3))
then
87 idtend=dtidx(100+ntke,index_of_process_conv_trans)
89 dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk)-gq0(:,:,ntk)
93 if (imp_physics == imp_physics_zhao_carr .or. &
94 imp_physics == imp_physics_zhao_carr_pdf .or. &
95 imp_physics == imp_physics_gfdl)
then
96 idtend=dtidx(100+ntcw,index_of_process_conv_trans)
98 dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)+clw(:,:,2) - gq0(:,:,ntcw)
101 idtend=dtidx(100+ntiw,index_of_process_conv_trans)
103 dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)-gq0(:,:,ntiw)
105 idtend=dtidx(100+ntcw,index_of_process_conv_trans)
107 dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,2)-gq0(:,:,ntcw)
110 idtend=dtidx(100+ntcw,index_of_process_conv_trans)
112 dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)+clw(:,:,2) - gq0(:,:,ntcw)
121 if (tracers_total > 0)
then
132 IF ( otsptflag(n) )
THEN
133 tracers = tracers + 1
134 if(n/=ntk .and. n/=ntlnc .and. n/=ntinc .and. n /= ntcw .and. n /= ntiw)
then
135 idtend=dtidx(100+n,index_of_process_conv_trans)
137 dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-gq0(:,:,n)
142 gq0(i,k,n) = clw(i,k,tracers)
152 if (imp_physics == imp_physics_zhao_carr .or. &
153 imp_physics == imp_physics_zhao_carr_pdf .or. &
154 imp_physics == imp_physics_gfdl)
then
155 gq0(1:im,:,ntcw) = clw(1:im,:,1) + clw(1:im,:,2)
157 elseif (ntiw > 0)
then
160 gq0(i,k,ntiw) = clw(i,k,1)
161 gq0(i,k,ntcw) = clw(i,k,2)
165 if ( imp_physics == imp_physics_nssl )
then
166 liqm = con_pi/6.*1.e3*(18.e-6)**3
167 icem = con_pi/6.*1.e3*(120.e-6)**3
168 qccn = nssl_cccn/1.225
172 IF ( nssl_ccn_on )
THEN
173 IF ( nssl_invertccn )
THEN
174 xccn = qccn - gq0(i,k,ntccn)
176 xccn = gq0(i,k,ntccn)
179 xccn = max(0.0, qccn - gq0(i,k,ntlnc))
182 IF ( gq0(i,k,ntlnc) > 0.0 .and. save_qc(i,k) > 0.0 )
THEN
183 xcwmas = max( liqm, clw(i,k,2)/gq0(i,k,ntlnc) )
188 IF ( gq0(i,k,ntinc) > 0.0 .and. save_qi(i,k) > 0.0 )
THEN
189 xcimas = max( liqm, clw(i,k,1)/gq0(i,k,ntinc) )
194 IF ( xccn > 0.0 )
THEN
195 xccw = min( xccn, max(0.0, (clw(i,k,2)-save_qc(i,k))) / xcwmas )
196 gq0(i,k,ntlnc) = gq0(i,k,ntlnc) + xccw
197 IF ( nssl_ccn_on )
THEN
198 IF ( nssl_invertccn )
THEN
200 gq0(i,k,ntccn) = gq0(i,k,ntccn) + xccw
203 gq0(i,k,ntccn) = gq0(i,k,ntccn) - xccw
208 gq0(i,k,ntinc) = gq0(i,k,ntinc) &
209 + max(0.0, (clw(i,k,1)-save_qi(i,k))) / xcimas
214 if (imp_physics == imp_physics_thompson .and. (ntlnc>0 .or. ntinc>0))
then
215 if_convert_dry_rho:
if (convert_dry_rho)
then
219 qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k))
221 rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+con_eps))
225 qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k))
227 nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k))
228 nc_mp(i,k) = max(zero, nc_mp(i,k) +
make_dropletnumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
230 gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k))
234 qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k))
236 ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k))
237 ni_mp(i,k) = max(zero, ni_mp(i,k) +
make_icenumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
239 gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k))
247 rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(spechum(i,k)+con_eps))
251 qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k))
253 gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) +
make_dropletnumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
257 qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k))
259 gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) +
make_icenumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
263 end if if_convert_dry_rho
264 if(ldiag3d .and. qdiag3d)
then
265 idtend = dtidx(100+ntlnc,index_of_process_conv_trans)
267 dtend(:,:,idtend) = dtend(:,:,idtend) + gq0(:,:,ntlnc) - save_lnc
269 idtend = dtidx(100+ntinc,index_of_process_conv_trans)
271 dtend(:,:,idtend) = dtend(:,:,idtend) + gq0(:,:,ntinc) - save_inc
279 gq0(i,k,ntcw) = clw(i,k,1) + clw(i,k,2)
287 clw(i,k,1) = clw(i,k,1) + clw(i,k,2)