11 subroutine gfs_suite_interstitial_3_run (otsptflag, &
12 im, levs, nn, cscnv,imfshalcnv, imfdeepcnv, &
13 imfshalcnv_samf, imfdeepcnv_samf, imfdeepcnv_c3, &
14 imfshalcnv_c3,progsigma, &
15 first_time_step, restart, &
16 satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, &
17 ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, &
18 xlon, xlat, gt0, gq0, sigmain,sigmaout,qmicro, &
19 imp_physics, imp_physics_mg, &
20 imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, &
21 imp_physics_gfdl, imp_physics_thompson, dtidx, ntlnc, &
22 imp_physics_wsm6, imp_physics_fer_hires, prsi, ntinc, &
24 prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, &
25 work1, work2, kpbl, kinver, ras, me, save_lnc, save_inc, &
26 ldiag3d, qdiag3d, index_of_process_conv_trans, &
27 clw, rhc, save_qc, save_qi, save_tcp, errmsg, errflg)
34 logical,
intent(in) :: otsptflag(:)
35 integer,
intent(in ) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, ntsw,&
36 ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, &
37 imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, &
38 imp_physics_nssl, me, index_of_process_conv_trans
39 integer,
intent(in ),
dimension(:) :: islmsk, kpbl, kinver
40 logical,
intent(in ) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras, progsigma
41 logical,
intent(in ) :: first_time_step, restart
42 integer,
intent(in ) :: imfshalcnv, imfdeepcnv, imfshalcnv_samf,imfdeepcnv_samf
43 integer,
intent(in ) :: imfshalcnv_c3,imfdeepcnv_c3
44 integer,
intent(in) :: ntinc, ntlnc
45 logical,
intent(in) :: ldiag3d, qdiag3d
46 integer,
dimension(:,:),
intent(in) :: dtidx
47 real,
dimension(:,:),
intent(out) :: save_lnc, save_inc
49 real(kind=kind_phys),
intent(in ) :: rhcbot, rhcmax, rhcpbl, rhctop
50 real(kind=kind_phys),
intent(in ),
dimension(:) :: work1, work2
51 real(kind=kind_phys),
intent(in ),
dimension(:,:) :: prsl, prslk
52 real(kind=kind_phys),
intent(in ),
dimension(:,:) :: prsi
53 real(kind=kind_phys),
intent(in ),
dimension(:) :: xlon, xlat
54 real(kind=kind_phys),
intent(in ),
dimension(:,:) :: gt0
55 real(kind=kind_phys),
intent(in ),
dimension(:,:,:) :: gq0
57 real(kind=kind_phys),
intent(inout ),
dimension(:,:),
optional :: sigmain
58 real(kind=kind_phys),
intent(inout ),
dimension(:,:),
optional :: sigmaout, qmicro
59 real(kind=kind_phys),
intent(inout),
dimension(:,:) :: rhc, save_qc
61 real(kind=kind_phys),
intent(inout),
dimension(:,:) :: save_qi
62 real(kind=kind_phys),
intent(inout),
dimension(:,:) :: save_tcp
63 real(kind=kind_phys),
intent(inout),
dimension(:,:,:) :: clw
65 character(len=*),
intent( out) :: errmsg
66 integer,
intent( out) :: errflg
69 integer :: i,k,n,tracers,kk
70 real(kind=kind_phys) :: tem, tem1, tem2
71 real(kind=kind_phys),
dimension(im) :: tx1, tx2, tx3, tx4
76 real(kind=kind_phys),
parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys
77 real(kind=kind_phys),
parameter :: slope_mg = 50.0_kind_phys, &
78 slope_upmg = 25.0_kind_phys
86 if(((imfshalcnv == imfshalcnv_samf) .or. (imfdeepcnv == imfdeepcnv_samf) &
87 .or. (imfshalcnv == imfshalcnv_c3) .or. (imfdeepcnv == imfdeepcnv_c3)) &
89 if(first_time_step .and. .not. restart)
then
106 if (cscnv .or. satmedmf .or. trans_trac .or. ras)
then
112 IF ( otsptflag(n) )
THEN
113 tracers = tracers + 1
116 clw(i,k,tracers) = gq0(i,k,n)
124 if (imp_physics == imp_physics_mg .and. rhcpbl < 0.5_kind_phys)
then
126 tx1(i) = one / prsi(i,1)
127 tx2(i) = one - rhcmax*work1(i)-rhcbot*work2(i)
129 kk = min(kinver(i), max(2,kpbl(i)))
130 tx3(i) = prsi(i,kk)*tx1(i)
131 tx4(i) = rhcpbl - rhctop*abs(cos(xlat(i)))
135 tem = prsl(i,k) * tx1(i)
136 tem1 = min(max((tem-tx3(i))*slope_mg, -20.0_kind_phys), 20.0_kind_phys)
139 tem2 = min(max((tx4(i)-tem)*slope_upmg, -20.0_kind_phys), 20.0_kind_phys)
140 if (islmsk(i) > 0)
then
141 tem1 = one / (one+exp(tem1+tem1))
143 tem1 = 2.0_kind_phys / (one+exp(tem1+tem1))
145 tem2 = one / (one+exp(tem2))
147 rhc(i,k) = min(rhcmax, max(0.7_kind_phys, one-tx2(i)*tem1*tem2))
156 tem = rhcbot - (rhcbot-rhcpbl) * (one-prslk(i,k)) / max(one-prslk(i,kk),1e-7)
158 tem = rhcpbl - (rhcpbl-rhctop) * (prslk(i,kk)-prslk(i,k)) / max(prslk(i,kk),1e-7)
162 tem = rhcbot - (rhcbot-rhcpbl) * (one-prslk(i,k)) / (one-prslk(i,kk))
164 tem = rhcpbl - (rhcpbl-rhctop) * (prslk(i,kk)-prslk(i,k)) / prslk(i,kk)
167 tem = rhcmax * work1(i) + tem * work2(i)
168 rhc(i,k) = max(zero, min(one,tem))
176 if (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_zhao_carr_pdf)
then
185 clw(i,k,1) = gq0(i,k,ntcw)
188 elseif (imp_physics == imp_physics_gfdl)
then
189 clw(1:im,:,1) = gq0(1:im,:,ntcw)
190 elseif (imp_physics == imp_physics_thompson)
then
193 clw(i,k,1) = gq0(i,k,ntiw)
194 clw(i,k,2) = gq0(i,k,ntcw)
195 save_tcp(i,k) = gt0(i,k)
199 save_qi(:,:) = clw(:,:,1)
200 save_qc(:,:) = clw(:,:,2)
202 save_qi(:,:) = clw(:,:,1)
204 else if (imp_physics == imp_physics_nssl )
then
207 clw(i,k,1) = gq0(i,k,ntiw)
208 clw(i,k,2) = gq0(i,k,ntcw)
211 save_qi(:,:) = clw(:,:,1)
212 save_qc(:,:) = clw(:,:,2)
213 elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg .or. imp_physics == imp_physics_fer_hires)
then
216 clw(i,k,1) = gq0(i,k,ntiw)
217 clw(i,k,2) = gq0(i,k,ntcw)
222 if(imp_physics == imp_physics_thompson .and. ldiag3d .and. qdiag3d)
then
223 if(dtidx(100+ntlnc,index_of_process_conv_trans)>0)
then
224 save_lnc = gq0(:,:,ntlnc)
226 if(dtidx(100+ntinc,index_of_process_conv_trans)>0)
then
227 save_inc = gq0(:,:,ntinc)