60 subroutine gfs_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblck, &
61 do_shum ,do_skeb, do_ca,ca_global,ca1,vfact_ca, &
62 zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,&
63 diss_est, ugrs, vgrs, tgrs, qgrs_wv, &
64 qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, &
65 gu0, gv0, gt0, gq0_wv, dtdtnp, &
66 gq0_cw, gq0_rw, gq0_sw, gq0_iw, gq0_gl, &
67 rain, rainc, tprcp, totprcp, cnvprcp, &
68 totprcpb, cnvprcpb, cplflx, cpllnd, &
69 rain_cpl, snow_cpl, drain_cpl, dsnow_cpl, &
70 ntcw,ntrw,ntsw,ntiw,ntgl, &
77 integer,
intent(in) :: im
78 integer,
intent(in) :: km
79 integer,
intent(in) :: kdt
80 real(kind_phys),
intent(in) :: delt
81 logical,
intent(in) :: do_sppt
82 logical,
intent(in) :: pert_mp
83 logical,
intent(in) :: do_ca
84 logical,
intent(in) :: ca_global
85 logical,
intent(in) :: use_zmtnblck
86 logical,
intent(in) :: do_shum
87 logical,
intent(in) :: do_skeb
88 real(kind_phys),
dimension(:),
intent(in) :: zmtnblck
90 real(kind_phys),
dimension(:,:),
intent(inout),
optional :: sppt_wts
92 real(kind_phys),
dimension(:,:),
intent(in),
optional :: skebu_wts
93 real(kind_phys),
dimension(:,:),
intent(in),
optional :: skebv_wts
95 real(kind_phys),
dimension(:,:),
intent(in),
optional :: shum_wts
96 real(kind_phys),
dimension(:,:),
intent(in) :: diss_est
97 real(kind_phys),
dimension(:,:),
intent(in) :: ugrs
98 real(kind_phys),
dimension(:,:),
intent(in) :: vgrs
99 real(kind_phys),
dimension(:,:),
intent(in) :: tgrs
100 real(kind_phys),
dimension(:,:),
intent(in) :: qgrs_wv
101 real(kind_phys),
dimension(:,:),
intent(in) :: qgrs_cw
102 real(kind_phys),
dimension(:,:),
intent(in) :: qgrs_rw
103 real(kind_phys),
dimension(:,:),
intent(in) :: qgrs_sw
104 real(kind_phys),
dimension(:,:),
intent(in) :: qgrs_iw
105 real(kind_phys),
dimension(:,:),
intent(in) :: qgrs_gl
106 real(kind_phys),
dimension(:,:),
intent(inout) :: gu0
107 real(kind_phys),
dimension(:,:),
intent(inout) :: gv0
108 real(kind_phys),
dimension(:,:),
intent(inout) :: gt0
109 real(kind_phys),
dimension(:,:),
intent(inout) :: gq0_wv
110 real(kind_phys),
dimension(:,:),
intent(inout) :: gq0_cw
111 real(kind_phys),
dimension(:,:),
intent(inout) :: gq0_rw
112 real(kind_phys),
dimension(:,:),
intent(inout) :: gq0_sw
113 real(kind_phys),
dimension(:,:),
intent(inout) :: gq0_iw
114 real(kind_phys),
dimension(:,:),
intent(inout) :: gq0_gl
115 integer,
intent(in) :: ntcw
116 integer,
intent(in) :: ntrw
117 integer,
intent(in) :: ntsw
118 integer,
intent(in) :: ntiw
119 integer,
intent(in) :: ntgl
120 real(kind_phys),
dimension(:,:),
intent(inout),
optional :: dtdtnp
121 real(kind_phys),
dimension(:),
intent(in) :: rain
122 real(kind_phys),
dimension(:),
intent(in) :: rainc
123 real(kind_phys),
dimension(:),
intent(inout) :: tprcp
124 real(kind_phys),
dimension(:),
intent(inout) :: totprcp
125 real(kind_phys),
dimension(:),
intent(inout) :: cnvprcp
126 real(kind_phys),
dimension(:),
intent(inout) :: totprcpb
127 real(kind_phys),
dimension(:),
intent(inout) :: cnvprcpb
128 logical,
intent(in) :: cplflx
129 logical,
intent(in) :: cpllnd
131 real(kind_phys),
dimension(:),
intent(inout),
optional :: rain_cpl
133 real(kind_phys),
dimension(:),
intent(inout),
optional :: snow_cpl
135 real(kind_phys),
dimension(:),
intent(in),
optional :: drain_cpl
136 real(kind_phys),
dimension(:),
intent(in),
optional :: dsnow_cpl
137 real(kind_phys),
dimension(:),
intent(in) :: vfact_ca
138 real(kind_phys),
dimension(:),
intent(in),
optional :: ca1
139 character(len=*),
intent(out) :: errmsg
140 integer,
intent(out) :: errflg
144 real(kind=kind_phys) :: upert, vpert, tpert, qpert, qnew, sppt_vwt
145 real(kind=kind_phys),
dimension(1:im,1:km) :: ca
155 if (zmtnblck(i).EQ.0.0)
then
158 if (k.GT.zmtnblck(i)+2)
then
161 if (k.LE.zmtnblck(i))
then
164 if (k.EQ.zmtnblck(i)+1)
then
167 if (k.EQ.zmtnblck(i)+2)
then
171 if (use_zmtnblck)
then
172 sppt_wts(i,k)=(sppt_wts(i,k)-1)*sppt_vwt+1.0
175 upert = (gu0(i,k) - ugrs(i,k)) * sppt_wts(i,k)
176 vpert = (gv0(i,k) - vgrs(i,k)) * sppt_wts(i,k)
177 tpert = (gt0(i,k) - tgrs(i,k) - (delt*dtdtnp(i,k))) * sppt_wts(i,k)
178 qpert = (gq0_wv(i,k) - qgrs_wv(i,k)) * sppt_wts(i,k)
180 gu0(i,k) = ugrs(i,k)+upert
181 gv0(i,k) = vgrs(i,k)+vpert
184 qnew = qgrs_wv(i,k)+qpert
185 if (qnew >= 1.0e-10)
then
187 gt0(i,k) = tgrs(i,k) + tpert + (delt*dtdtnp(i,k))
191 qpert = (gq0_cw(i,k) - qgrs_cw(i,k)) * sppt_wts(i,k)
192 qnew = qgrs_cw(i,k)+qpert
199 qpert = (gq0_rw(i,k) - qgrs_rw(i,k)) * sppt_wts(i,k)
200 qnew = qgrs_rw(i,k)+qpert
207 qpert = (gq0_sw(i,k) - qgrs_sw(i,k)) * sppt_wts(i,k)
208 qnew = qgrs_sw(i,k)+qpert
215 qpert = (gq0_iw(i,k) - qgrs_iw(i,k)) * sppt_wts(i,k)
216 qnew = qgrs_iw(i,k)+qpert
223 qpert = (gq0_gl(i,k) - qgrs_gl(i,k)) * sppt_wts(i,k)
224 qnew = qgrs_gl(i,k)+qpert
235 tprcp(:) = sppt_wts(:,15)*tprcp(:)
236 totprcp(:) = totprcp(:) + (sppt_wts(:,15) - 1 )*rain(:)
238 cnvprcp(:) = cnvprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:)
240 totprcpb(:) = totprcpb(:) + (sppt_wts(:,15) - 1 )*rain(:)
241 cnvprcpb(:) = cnvprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:)
243 if (cplflx .or. cpllnd)
then
244 rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:)
247 snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:)
254 if (do_ca .and. ca_global)
then
262 if (zmtnblck(i).EQ.0.0)
then
265 if (k.GT.zmtnblck(i)+2)
then
268 if (k.LE.zmtnblck(i))
then
271 if (k.EQ.zmtnblck(i)+1)
then
274 if (k.EQ.zmtnblck(i)+2)
then
279 ca(i,k)=((ca1(i)-1.)*sppt_vwt*vfact_ca(k))+1.0
281 upert = (gu0(i,k) - ugrs(i,k)) * ca(i,k)
282 vpert = (gv0(i,k) - vgrs(i,k)) * ca(i,k)
283 tpert = (gt0(i,k) - tgrs(i,k) - (delt*dtdtnp(i,k))) * ca(i,k)
284 qpert = (gq0_wv(i,k) - qgrs_wv(i,k)) * ca(i,k)
285 gu0(i,k) = ugrs(i,k)+upert
286 gv0(i,k) = vgrs(i,k)+vpert
288 qnew = qgrs_wv(i,k)+qpert
289 if (qnew >= 1.0e-10)
then
291 gt0(i,k) = tgrs(i,k) + tpert + (delt*dtdtnp(i,k))
295 qpert = (gq0_cw(i,k) - qgrs_cw(i,k)) * ca(i,k)
296 qnew = qgrs_cw(i,k)+qpert
303 qpert = (gq0_rw(i,k) - qgrs_rw(i,k)) * ca(i,k)
304 qnew = qgrs_rw(i,k)+qpert
311 qpert = (gq0_sw(i,k) - qgrs_sw(i,k)) * ca(i,k)
312 qnew = qgrs_sw(i,k)+qpert
319 qpert = (gq0_iw(i,k) - qgrs_iw(i,k)) * ca(i,k)
320 qnew = qgrs_iw(i,k)+qpert
327 qpert = (gq0_gl(i,k) - qgrs_gl(i,k)) * ca(i,k)
328 qnew = qgrs_gl(i,k)+qpert
339 tprcp(:) = ca(:,15)*tprcp(:)
340 totprcp(:) = totprcp(:) + (ca(:,15) - 1 )*rain(:)
342 cnvprcp(:) = cnvprcp(:) + (ca(:,15) - 1 )*rainc(:)
344 totprcpb(:) = totprcpb(:) + (ca(:,15) - 1 )*rain(:)
345 cnvprcpb(:) = cnvprcpb(:) + (ca(:,15) - 1 )*rainc(:)
347 if (cplflx .or. cpllnd)
then
348 rain_cpl(:) = rain_cpl(:) + (ca(:,15) - 1.0)*drain_cpl(:)
351 snow_cpl(:) = snow_cpl(:) + (ca(:,15) - 1.0)*dsnow_cpl(:)
361 gq0_wv(:,k) = gq0_wv(:,k)*(1.0 + shum_wts(:,k))
367 gu0(:,k) = gu0(:,k)+skebu_wts(:,k)*(diss_est(:,k))
368 gv0(:,k) = gv0(:,k)+skebv_wts(:,k)*(diss_est(:,k))