155 NTR , nctp , & !DD dimensions
156 otspt , lat , kdt , &
157 t , q , rain1 , clw , &
158 zm , zi , pap , paph , &
159 delta , delti , ud_mf , dd_mf , dt_mf, &
160 u , v , fscav , fswtr, &
161 cbmfx , mype , wcbmaxm , precz0in, preczhin, &
162 clmdin , sigma , do_aw , do_awdd , flx_form, &
164 QLCN, QICN, w_upi, cf_upi, CNV_MFD, & ! for coupling to MG microphysics
165 CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE, &
166 mp_phys,errmsg,errflg)
173 INTEGER,
INTENT(IN) :: ijsdim, kmax, ntracp1, nn, ntr, mype, nctp, mp_phys, kdt, lat
174 logical,
intent(in) :: otspt(:,:)
179 real(kind_phys),
intent(inout) :: t(:,:)
180 real(kind_phys),
intent(inout) :: q(:,:)
181 real(kind_phys),
intent(inout) :: clw(:,:,:)
182 real(kind_phys),
intent(in) :: pap(:,:)
183 real(kind_phys),
intent(in) :: paph(:,:)
184 real(kind_phys),
intent(in) :: zm(:,:)
185 real(kind_phys),
intent(in) :: zi(:,:)
186 real(kind_phys),
intent(in) :: fscav(:), fswtr(:), wcbmaxm(:)
187 real(kind_phys),
intent(in) :: precz0in, preczhin, clmdin
189 real(kind_phys),
intent(inout) :: u(:,:)
190 real(kind_phys),
intent(inout) :: v(:,:)
192 real(kind_phys),
intent(in) :: delta
193 real(kind_phys),
intent(in) :: delti
194 logical,
intent(in) :: do_aw, do_awdd, flx_form
198 real(kind_phys),
intent(inout),
optional :: cbmfx(:,:)
203 real(kind_phys),
intent(inout),
dimension(:,:),
optional :: ud_mf
204 real(kind_phys),
intent(inout),
dimension(:,:) :: dd_mf, dt_mf
206 real(kind_phys),
intent(out) :: rain1(:)
210 real(kind_phys),
intent(out),
dimension(:,:),
optional :: qlcn, qicn, w_upi,cnv_mfd, &
211 cnv_dqldt, clcn, cnv_fice, &
212 cnv_ndrop, cnv_nice, cf_upi
214 logical,
intent(in) :: lprnt
215 integer,
intent(in) :: ipr
216 integer,
intent(inout) :: kcnv(:)
217 character(len=*),
intent(out) :: errmsg
218 integer,
intent(out) :: errflg
223 real(kind_phys),
intent(out),
dimension(:,:) :: sigma
230 real(kind_phys),
dimension(IJSDIM,KMAX+1,nctp) :: vverti, sigmai
232 real(kind_phys) gtt(ijsdim,kmax)
233 real(kind_phys) gtq(ijsdim,kmax,ntr)
234 real(kind_phys) gtu(ijsdim,kmax)
235 real(kind_phys) gtv(ijsdim,kmax)
236 real(kind_phys) cmdet(ijsdim,kmax)
237 real(kind_phys) gtprp(ijsdim,kmax+1)
238 real(kind_phys) gsnwp(ijsdim,kmax+1)
239 real(kind_phys) gmfx0(ijsdim,kmax+1)
240 real(kind_phys) gmfx1(ijsdim,kmax+1)
241 integer kt(ijsdim,nctp)
243 real(kind_phys) :: cape(ijsdim)
244 real(kind_phys) :: prec(ijsdim)
245 real(kind_phys) :: snow(ijsdim)
249 real(kind_phys) gdt(ijsdim,kmax)
250 real(kind_phys) gdq(ijsdim,kmax,ntr)
251 real(kind_phys) gdu(ijsdim,kmax)
252 real(kind_phys) gdv(ijsdim,kmax)
253 real(kind_phys) gdtm(ijsdim,kmax+1)
254 real(kind_phys) gdp(ijsdim,kmax)
255 real(kind_phys) gdpm(ijsdim,kmax+1)
256 real(kind_phys) gdz(ijsdim,kmax)
257 real(kind_phys) gdzm(ijsdim,kmax+1)
258 real(kind_phys) delp(ijsdim,kmax)
259 real(kind_phys) delpi(ijsdim,kmax)
265 integer ktmax(ijsdim)
266 real(kind_phys) :: ftintm, wrk, wrk1, tem
267 integer i, k, n, ists, iens, kp1
272 real(kind_phys),
parameter :: tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf), tcl=2.0
273 logical,
save :: first=.true.
285 clmp = (one-clmd)*(pa+pa)
303 gdzm(i,k) = zi(i,k) * gravi
304 gdpm(i,k) = paph(i,k)
313 gdz(i,k) = zm(i,k) * gravi
316 delp(i,k) = paph(i,k) - paph(i,k+1)
317 delpi(i,k) = grav / delp(i,k)
332 if (clw(1,1,2) <= -999.0)
then
335 tem = clw(i,k,1) * max(zero, min(one, (tcr-t(i,k))*tcrf))
336 clw(i,k,2) = clw(i,k,1) - tem
344 tem = min(clw(i,k,1), 0.0)
345 wrk = min(clw(i,k,2), 0.0)
346 clw(i,k,1) = clw(i,k,1) - tem
347 clw(i,k,2) = clw(i,k,2) - wrk
348 gdq(i,k,1) = gdq(i,k,1) + tem + wrk
357 gdq(i,k,n) = clw(i,k,n-1)
371 wrk1 = one / log(gdp(i,k-1)*wrk)
372 ftintm = wrk1 * log(gdpm(i,k)*wrk)
373 gdtm(i,k) = ftintm*gdt(i,k-1) + (one-ftintm)*gdt(i,k)
378 gdtm(i,kmax+1) = gdt(i,kmax)
398 call cs_cumlus (ijsdim, ijsdim, kmax , ntr , &
399 otspt(1:ntr,1), otspt(1:ntr,2), &
401 gtt , gtq , gtu , gtv , &
403 gtprp , gsnwp , gmfx0 , &
404 gmfx1 , cape , kt , &
406 gdt , gdq , gdu , gdv , &
408 gdp , gdpm , gdz , gdzm , &
410 delta , delti , ists , iens, mype,&
411 fscav, fswtr, wcbmaxm, nctp, &
412 sigmai, sigma, vverti, &
413 do_aw, do_awdd, flx_form)
425 clw(i,k,n-1) = max(zero, gdq(i,k,n) + gtq(i,k,n) * delta)
436 q(i,k) = max(zero, gdq(i,k,1) + gtq(i,k,1) * delta)
437 t(i,k) = gdt(i,k) + gtt(i,k) * delta
438 u(i,k) = gdu(i,k) + gtu(i,k) * delta
439 v(i,k) = gdv(i,k) + gtv(i,k) * delta
441 ud_mf(i,k) = gmfx0(i,k)
442 dd_mf(i,k) = gmfx1(i,k)
443 dt_mf(i,k) = cmdet(i,k)
448 if (mp_phys == 10)
then
453 qicn(i,k) = max(0.0, clw(i,k,1)-gdq(i,k,2))
454 qlcn(i,k) = max(0.0, clw(i,k,2)-gdq(i,k,3))
457 wrk = qicn(i,k) + qlcn(i,k)
458 if (wrk > 1.0e-12)
then
459 cnv_fice(i,k) = qicn(i,k) / wrk
465 cnv_mfd(i,k) = dt_mf(i,k)
466 cnv_dqldt(i,k) = wrk / delta
470 cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1))
482 w_upi(i,k) = w_upi(i,k) + vverti(i,k,n)
484 if (sigma(i,k) > 1.0e-10)
then
485 w_upi(i,k) = w_upi(i,k) / sigma(i,k)
494 qicn(i,k) = max(0.0, clw(i,k,1)-gdq(i,k,2))
495 qlcn(i,k) = max(0.0, clw(i,k,2)-gdq(i,k,3))
496 cnv_fice(i,k) = qicn(i,k) / max(1.0e-10,qicn(i,k)+qlcn(i,k))
499 cnv_mfd(i,k) = dt_mf(i,k)
500 cnv_dqldt(i,k) = (qicn(i,k)+qlcn(i,k)) / delta
504 cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1))
508 w_upi(i,k) = ud_mf(i,k)*(t(i,k)+epsvt*gdq(i,k,1)) * rair &
509 / (max(cf_upi(i,k),1.e-12)*gdp(i,k))
520 ktmax(i) = max(ktmax(i), kt(i,n))
527 if (prec(i)+snow(i) > 0.0)
then
538 ud_mf(i,k) = ud_mf(i,k) * delta
539 dd_mf(i,k) = dd_mf(i,k) * delta
540 dt_mf(i,k) = dt_mf(i,k) * delta
546 rain1(i) = prec(i) * (delta*0.001)
588 SUBROUTINE cs_cumlus (im , IJSDIM, KMAX , NTR , & !DD dimensions
589 otspt1, otspt2, lprnt , ipr , &
590 GTT , GTQ , GTU , GTV , & ! output
592 GTPRP , GSNWP , GMFX0 , & ! output
593 GMFX1 , CAPE , KT , & ! output
595 GDT , GDQ , GDU , GDV , & ! input
597 GDP , GDPM , GDZ , GDZM , & ! input
599 DELTA , DELTI , ISTS , IENS, mype,& ! input
600 fscav, fswtr, wcbmaxm, nctp, & !
601 sigmai, sigma, vverti, & ! input/output !DDsigma
602 do_aw, do_awdd, flx_form)
606 Integer,
parameter :: ntrq=4
607 INTEGER,
INTENT(IN) :: im, IJSDIM, KMAX, NTR, mype, nctp, ipr
608 logical,
intent(in) :: do_aw, do_awdd, flx_form
609 logical,
intent(in) :: otspt1(ntr), otspt2(ntr), lprnt
610 REAL(kind_phys),
intent(in) :: DELP (IJSDIM, KMAX)
611 REAL(kind_phys),
intent(in) :: DELPINV (IJSDIM, KMAX)
614 REAL(kind_phys),
INTENT(OUT) :: GTT (IJSDIM, KMAX )
615 REAL(kind_phys),
INTENT(OUT) :: GTQ (IJSDIM, KMAX, NTR)
616 REAL(kind_phys),
INTENT(OUT) :: GTU (IJSDIM, KMAX )
617 REAL(kind_phys),
INTENT(OUT) :: GTV (IJSDIM, KMAX )
618 REAL(kind_phys),
INTENT(OUT) :: CMDET (IJSDIM, KMAX )
619 REAL(kind_phys) :: GTLDET( IJSDIM, KMAX )
620 REAL(kind_phys) :: GTIDET( IJSDIM, KMAX )
622 REAL(kind_phys),
INTENT(OUT) :: GTPRP (IJSDIM, KMAX+1 )
623 REAL(kind_phys),
INTENT(OUT) :: GSNWP (IJSDIM, KMAX+1 )
624 REAL(kind_phys),
INTENT(OUT) :: GMFX0 (IJSDIM, KMAX+1 )
625 REAL(kind_phys),
INTENT(OUT) :: GMFX1 (IJSDIM, KMAX+1 )
627 REAL(kind_phys),
INTENT(OUT) :: CAPE (IJSDIM )
628 INTEGER ,
INTENT(OUT) :: KT (IJSDIM, NCTP )
631 REAL(kind_phys),
INTENT(INOUT) :: CBMFX ( IM, NCTP )
634 real(kind_phys),
intent(out) :: sigmai(IM,KMAX+1,nctp)
635 real(kind_phys),
intent(out) :: vverti(IM,KMAX+1,nctp)
636 real(kind_phys),
intent(out) :: sigma(IM,KMAX+1)
644 real(kind_phys),
dimension(IM,KMAX) :: &
645 condtermt, condtermq, frzterm, prectermq, prectermfrz
650 REAL(kind_phys),
INTENT(IN) :: GDT (IJSDIM, KMAX )
651 REAL(kind_phys),
INTENT(IN) :: GDQ (IJSDIM, KMAX, NTR)
652 REAL(kind_phys),
INTENT(IN) :: GDU (IJSDIM, KMAX )
653 REAL(kind_phys),
INTENT(IN) :: GDV (IJSDIM, KMAX )
654 REAL(kind_phys),
INTENT(IN) :: GDTM (IJSDIM, KMAX+1 )
655 REAL(kind_phys),
INTENT(IN) :: GDP (IJSDIM, KMAX )
656 REAL(kind_phys),
INTENT(IN) :: GDPM (IJSDIM, KMAX+1 )
657 REAL(kind_phys),
INTENT(IN) :: GDZ (IJSDIM, KMAX )
658 REAL(kind_phys),
INTENT(IN) :: GDZM (IJSDIM, KMAX+1 )
659 REAL(kind_phys),
INTENT(IN) :: DELTA
660 REAL(kind_phys),
INTENT(IN) :: DELTI
661 INTEGER,
INTENT(IN) :: ISTS, IENS
663 real(kind_phys),
intent(in) :: fscav(ntr), fswtr(ntr), wcbmaxm(ijsdim)
666 REAL(kind_phys),
allocatable :: GPRCC (:, :)
667 REAL(kind_phys) GSNWC ( IJSDIM )
668 REAL(kind_phys) CUMCLW( IJSDIM, KMAX )
669 REAL(kind_phys) CUMFRC( IJSDIM )
671 REAL(kind_phys) QLIQC ( IJSDIM, KMAX )
672 REAL(kind_phys) QICEC ( IJSDIM, KMAX )
673 REAL(kind_phys) GPRCPF( IJSDIM, KMAX )
674 REAL(kind_phys) GSNWPF( IJSDIM, KMAX )
676 REAL(kind_phys) GTCFRC( IJSDIM, KMAX )
677 REAL(kind_phys) FLIQC ( IJSDIM, KMAX )
687 REAL(kind_phys) GDCFRC( IJSDIM, KMAX )
691 REAL(kind_phys) GDW ( IJSDIM, KMAX )
692 REAL(kind_phys) GDQS ( IJSDIM, KMAX )
693 REAL(kind_phys) FDQS ( IJSDIM, KMAX )
694 REAL(kind_phys) GAM ( IJSDIM, KMAX )
695 REAL(kind_phys) GDS ( IJSDIM, KMAX )
696 REAL(kind_phys) GDH ( IJSDIM, KMAX )
697 REAL(kind_phys) GDHS ( IJSDIM, KMAX )
699 REAL(kind_phys) GCYM ( IJSDIM, KMAX, NCTP )
700 REAL(kind_phys) GCHB ( IJSDIM )
701 REAL(kind_phys) GCWB ( IJSDIM )
702 REAL(kind_phys) GCtrB ( IJSDIM, ntrq:ntr )
703 REAL(kind_phys) GCUB ( IJSDIM )
704 REAL(kind_phys) GCVB ( IJSDIM )
705 REAL(kind_phys) GCIB ( IJSDIM )
706 REAL(kind_phys) ELAM ( IJSDIM, KMAX, NCTP )
707 REAL(kind_phys) GCYT ( IJSDIM, NCTP )
708 REAL(kind_phys) GCHT ( IJSDIM, NCTP )
709 REAL(kind_phys) GCQT ( IJSDIM, NCTP )
710 REAL(kind_phys) GCwT ( IJSDIM )
711 REAL(kind_phys) GCUT ( IJSDIM, NCTP )
712 REAL(kind_phys) GCVT ( IJSDIM, NCTP )
713 REAL(kind_phys) GCLT ( IJSDIM, NCTP )
714 REAL(kind_phys) GCIT ( IJSDIM, NCTP )
715 REAL(kind_phys) GCtrT (IJSDIM, ntrq:ntr, NCTP)
716 REAL(kind_phys) GTPRT ( IJSDIM, NCTP )
717 REAL(kind_phys) GCLZ ( IJSDIM, KMAX )
718 REAL(kind_phys) GCIZ ( IJSDIM, KMAX )
720 REAL(kind_phys) ACWF ( IJSDIM )
721 REAL(kind_phys) GPRCIZ( IJSDIM, KMAX+1, NCTP )
722 REAL(kind_phys) GSNWIZ( IJSDIM, KMAX+1, NCTP )
723 REAL(kind_phys) GTPRC0( IJSDIM )
725 REAL(kind_phys) GMFLX ( IJSDIM, KMAX+1 )
726 REAL(kind_phys) QLIQ ( IJSDIM, KMAX )
727 REAL(kind_phys) QICE ( IJSDIM, KMAX )
728 REAL(kind_phys) GPRCI ( IJSDIM, KMAX )
729 REAL(kind_phys) GSNWI ( IJSDIM, KMAX )
731 REAL(kind_phys) GPRCP ( IJSDIM, KMAX+1 )
733 REAL(kind_phys) GTEVP ( IJSDIM, KMAX )
734 REAL(kind_phys) GMDD ( IJSDIM, KMAX+1 )
736 REAL(kind_phys) CUMHGT( IJSDIM, NCTP )
737 REAL(kind_phys) CTOPP ( IJSDIM )
739 REAL(kind_phys) GDZTR ( IJSDIM )
740 REAL(kind_phys) FLIQOU( IJSDIM, KMAX )
744 INTEGER KB ( IJSDIM )
745 INTEGER KSTRT ( IJSDIM )
747 REAL(kind_phys) CIN ( IJSDIM )
748 INTEGER JBUOY ( IJSDIM )
749 REAL(kind_phys) DELZ, BUOY, DELWC, DELER
752 REAL(kind_phys) WCBX (IJSDIM)
755 INTEGER KTMX ( NCTP )
757 REAL(kind_phys) TIMED
758 REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X
761 INTEGER KBMX, I, K, CTP, ierr, n, kp1, l, l1, kk, kbi, kmi, km1
762 real(kind_phys) tem1, tem2, tem3, cbmfl, mflx_e, teme, tems
764 REAL(kind_phys) HBGT ( IJSDIM )
765 REAL(kind_phys) WBGT ( IJSDIM )
768 REAL(kind_phys) lamdai( IJSDIM, KMAX+1, nctp )
769 REAL(kind_phys) lamdaprod( IJSDIM, KMAX+1 )
770 REAL(kind_phys) gdrhom
771 REAL(kind_phys) gdtvm
772 REAL(kind_phys) gdqm, gdwm,gdlm, gdim
773 REAL(kind_phys) gdtrm(ntrq:ntr)
774 character(len=4) :: cproc
777 REAL(kind_phys) wcv( IJSDIM, KMAX+1, nctp)
778 REAL(kind_phys) GCTM ( IJSDIM, KMAX+1 )
779 REAL(kind_phys) GCQM ( IJSDIM, KMAX+1, nctp )
780 REAL(kind_phys) GCwM ( IJSDIM, KMAX+1, nctp )
781 REAL(kind_phys) GCiM ( IJSDIM, KMAX+1 )
782 REAL(kind_phys) GClM ( IJSDIM, KMAX+1 )
783 REAL(kind_phys) GChM ( IJSDIM, KMAX+1, nctp )
784 REAL(kind_phys) GCtrM (IJSDIM, KMAX, ntrq:ntr)
787 REAL(kind_phys),
dimension(ijsdim,Kmax+1,nctp) :: sfluxtem, qvfluxtem, qlfluxtem, qifluxtem
788 REAL(kind_phys),
dimension(ijsdim,Kmax+1,ntrq:ntr,nctp) :: trfluxtem
790 REAL(kind_phys),
dimension(ijsdim,Kmax+1) :: dtcondtem, dqcondtem, dtfrztem, dqprectem,dfrzprectem
791 REAL(kind_phys),
dimension(ijsdim,Kmax) :: dtevap, dqevap, dtmelt, dtsubl
792 REAL(kind_phys),
dimension(ijsdim) :: moistening_aw
793 real(kind_phys) rhs_q, rhs_h, sftem, qftem, qlftem, qiftem
794 real(kind_phys),
dimension(ijsdim,kmax+1) :: gctbl, gcqbl,gcwbl, gcqlbl, gcqibl
795 real(kind_phys),
dimension(ijsdim,kmax,ntrq:ntr) :: gctrbl
796 real(kind_phys),
dimension(ijsdim,kmax+1) :: sigmad
797 real(kind_phys) :: fsigma( IJSDIM, KMAX+1 )
798 real(kind_phys) :: lamdamax
800 real(kind_phys) :: pr_tot, pr_ice, pr_liq
804 REAL(kind_phys) :: WCBMIN = 0._kind_phys
813 REAL(kind_phys) dtdwn ( IJSDIM, KMAX )
814 REAL(kind_phys) dqvdwn ( IJSDIM, KMAX )
815 REAL(kind_phys) dqldwn ( IJSDIM, KMAX )
816 REAL(kind_phys) dqidwn ( IJSDIM, KMAX )
817 REAL(kind_phys),
dimension(ijsdim,kmax,ntrq:ntr) :: dtrdwn
819 LOGICAL :: OINICB = .false.
821 REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys
822 REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys
823 REAL(kind_phys) :: SKWMAX = 0.566_kind_phys
825 REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys
826 REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys
827 REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys
836 real(kind=kind_phys),
parameter :: zero=0.0, one=1.0
837 real(kind=kind_phys) :: tem,
esat
839 LOGICAL,
SAVE :: OFIRST = .true.
885 sfluxtem(i,k,ctp) = zero
886 qvfluxtem(i,k,ctp) = zero
887 qlfluxtem(i,k,ctp) = zero
888 qifluxtem(i,k,ctp) = zero
894 trfluxtem(i,k,n,ctp) = zero
901 condtermt(i,k) = zero
902 condtermq(i,k) = zero
904 prectermq(i,k) = zero
905 prectermfrz(i,k) = zero
937 gdw(i,k) = gdq(i,k,1) + gdq(i,k,itl) + gdq(i,k,iti)
945 esat = min(gdp(i,k), fpvs(gdt(i,k)))
946 gdqs(i,k) = min(epsv*
esat/max(gdp(i,k)+epsvm1*
esat, 1.0e-10), 0.1)
948 fdqs(i,k) = gdqs(i,k) * tem * (fact1 + fact2*tem)
949 gam(i,k) = elocp*fdqs(i,k)
950 gds(i,k) = cp*gdt(i,k) + grav*gdz(i,k)
951 gdh(i,k) = gds(i,k) + el*gdq(i,k,1)
952 gdhs(i,k) = gds(i,k) + el*gdqs(i,k)
961 gamx = (gdtm(i,k+1)-gdtm(i,k)) / (gdzm(i,k+1)-gdzm(i,k))
962 IF ((gdp(i,k) < pstrmx .AND. gamx > gcrstr) .OR. gdp(i,k) < pstrmn)
THEN
963 kstrt(i) = min(k, kstrt(i))
976 CALL cumbas(ijsdim, kmax , &
977 kb , gcym(:,:,1) , kbmx , &
979 gchb , gcwb , gcub , gcvb , &
981 gdh , gdw , gdhs , gdqs , &
982 gdq(:,:,iti) , gdu , gdv , gdzm , &
983 gdpm , fdqs , gam , &
986 gctbl, gcqbl,gdq,gcwbl, gcqlbl, gcqibl, gctrbl)
999 buoy = (gdh(i,1)-gdhs(i,k)) / ((one+elocp*fdqs(i,k)) * cp*gdt(i,k))
1001 buoy = (gds(i,1)-gds(i,k)) / (cp*gdt(i,k))
1003 IF (buoy > zero .AND. jbuoy(i) >= -1)
THEN
1004 cape(i) = cape(i) + buoy * grav * (gdzm(i,k+1) - gdzm(i,k))
1006 ELSEIF (buoy < zero .AND. jbuoy(i) /= 2)
THEN
1007 cin(i) = cin(i) + buoy * grav * (gdzm(i,k+1) - gdzm(i,k))
1014 IF (jbuoy(i) /= 2) cin(i) = -999.d0
1015 if (cin(i) < cincrit) kb(i) = -1
1023 lamdaprod(i,k) = one
1031 lamdai(i,k,ctp) = zero
1032 sigmai(i,k,ctp) = zero
1033 vverti(i,k,ctp) = zero
1042 gcym(i,k,ctp) = gcym(i,k,1)
1049 tem = ctp / dble(nctp)
1051 delwc = tem * (wcbmaxm(i) - wcbmin)
1052 wcbx(i) = delwc * delwc
1064 CALL cumup(ijsdim, kmax, ntr, ntrq, &
1066 gclz , gciz , gprciz(:,:,ctp), gsnwiz(:,:,ctp), &
1067 gcyt(:,ctp) , gcht(:,ctp) , gcqt(:,ctp), &
1068 gclt(:,ctp) , gcit(:,ctp) , gtprt(:,ctp), &
1069 gcut(:,ctp) , gcvt(:,ctp) , gctrt(:,ntrq:ntr,ctp), &
1070 kt(:,ctp) , ktmx(ctp) , &
1073 gchb , gcwb , gcub , gcvb , &
1075 gdu , gdv , gdh , gdw , &
1076 gdhs , gdqs , gdt , gdtm , &
1077 gdq , gdq(:,:,iti) , gdz , gdzm , &
1078 gdpm , fdqs , gam , gdztr , &
1080 kb , ctp , ists , iens , &
1081 gctm , gcqm(:,:,ctp), gcwm(:,:,ctp), gchm(:,:,ctp),&
1082 gcwt, gclm, gcim, gctrm, &
1086 CALL cumbmx(ijsdim, kmax, &
1088 acwf , gcyt(:,ctp), gdzm , &
1089 gdw , gdqs , delp , &
1090 kt(:,ctp), ktmx(ctp) , kb , &
1091 delti , ists , iens )
1099 dqcondtem(i,k) = zero
1100 dqprectem(i,k) = zero
1101 dfrzprectem(i,k) = zero
1102 dtfrztem(i,k) = zero
1103 dtcondtem(i,k) = zero
1108 cbmfl = cbmfx(i,ctp)
1111 if(cbmfl > zero)
then
1116 gdqm = half * (gdq(i,k,1) + gdq(i,km1,1))
1118 gdlm = half * (gdq(i,k,itl) + gdq(i,km1,itl))
1119 gdim = half * (gdq(i,k,iti) + gdq(i,km1,iti))
1121 gdtrm(n) = half * (gdq(i,k,n) + gdq(i,km1,n))
1123 mflx_e = gcym(i,k,ctp) * cbmfl
1130 lamdai(i,k,ctp) = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) &
1131 / (gdpm(i,k)*wcv(i,k,ctp))
1156 tem = - gcym(i,l,ctp) * cbmfl
1160 gdqm = half * (gdq(i,l,1) + gdq(i,l1,1))
1161 gdlm = half * (gdq(i,l,itl) + gdq(i,l1,itl))
1162 gdim = half * (gdq(i,l,iti) + gdq(i,l1,iti))
1165 gdtrm(n) = half * (gdq(i,l,n) + gdq(i,l1,n))
1170 sfluxtem(i,l,ctp) = tem * (gdtm(i,l)-gctbl(i,l))
1171 qvfluxtem(i,l,ctp) = tem * (gdqm-gcqbl(i,l))
1172 qlfluxtem(i,l,ctp) = tem * (gdlm-gcqlbl(i,l))
1173 qifluxtem(i,l,ctp) = tem * (gdim-gcqibl(i,l))
1175 trfluxtem(i,l,n,ctp) = tem * (gdtrm(n)-gctrbl(i,l,n))
1200 sfluxtem(i,k,ctp) = tem * (gdtm(i,k)+gocp*gdzm(i,k)-gctm(i,k))
1201 qvfluxtem(i,k,ctp) = tem * (gdqm-gcqm(i,k,ctp))
1202 qlfluxtem(i,k,ctp) = tem * (gdlm-gclm(i,k))
1203 qifluxtem(i,k,ctp) = tem * (gdim-gcim(i,k))
1205 trfluxtem(i,k,n,ctp) = tem * (gdtrm(n)-gctrm(i,k,n))
1282 CALL cumflx(im , ijsdim, kmax , &
1283 gmfx0 , gprci , gsnwi , cmdet, &
1284 qliq , qice , gtprc0, &
1285 cbmfx(:,ctp) , gcym(:,:,ctp), gprciz(:,:,ctp), gsnwiz(:,:,ctp) , &
1286 gtprt(:,ctp) , gclz , gciz , gcyt(:,ctp),&
1287 kb , kt(:,ctp) , ktmx(ctp) , &
1295 gmflx(i,k) = gmfx0(i,k)
1300 IF (ktmx(ctp) > ktmxt) ktmxt = ktmx(ctp)
1319 if (.not. flx_form)
then
1320 CALL cumdet(im , ijsdim, kmax , ntr , ntrq , &
1321 gtt , gtq , gtu , gtv , &
1322 gdh , gdq , gdu , gdv , &
1325 cbmfx , gcyt , delpinv , gcht , gcqt , &
1326 gclt , gcit , gcut , gcvt , gdq(:,:,iti),&
1328 kt , ists , iens, nctp )
1339 lamdamax = maxval(lamdai(i,k,:))
1340 do while (lamdamax > zero)
1341 loclamdamax = maxloc(lamdai(i,k,:),dim=1)
1342 lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai(i,k,loclamdamax))
1343 sigmai(i,k,loclamdamax) = lamdai(i,k,loclamdamax) / lamdaprod(i,k)
1344 sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,loclamdamax)))
1345 vverti(i,k,loclamdamax) = sigmai(i,k,loclamdamax) * wcv(i,k,loclamdamax)
1348 lamdai(i,k,loclamdamax) = -lamdai(i,k,loclamdamax)
1350 lamdamax = maxval(lamdai(i,k,:))
1353 lamdai(i,k,:) = abs(lamdai(i,k,:))
1363 dtcondtem(:,:) = zero
1364 dqcondtem(:,:) = zero
1365 dqprectem(:,:) = zero
1366 dfrzprectem(:,:) = zero
1367 dtfrztem(:,:) = zero
1369 cbmfl = cbmfx(i,ctp)
1371 if(cbmfl > zero)
then
1379 tem = cbmfl * (one - 0.5*(sigma(i,k)+sigma(i,km1)))
1380 tem1 = gcym(i,k,ctp) * (one - sigma(i,k))
1381 tem2 = gcym(i,km1,ctp) * (one - sigma(i,km1))
1382 rhs_h = cbmfl * (tem1*gchm(i,k,ctp) - (tem2*gchm(i,km1,ctp) &
1383 + gdh(i,km1)*(tem1-tem2)) )
1384 rhs_q = cbmfl * (tem1*(gcwm(i,k,ctp)-gcqm(i,k,ctp)) &
1385 - (tem2*(gcwm(i,km1,ctp)-gcqm(i,km1,ctp)) &
1386 + (gdw(i,km1)-gdq(i,km1,1))*(tem1-tem2)) )
1388 dqcondtem(i,km1) = -rhs_q
1389 dqprectem(i,km1) = tem * (gprciz(i,k,ctp) + gsnwiz(i,k,ctp))
1390 dfrzprectem(i,km1) = tem * gsnwiz(i,k,ctp)
1391 dtfrztem(i,km1) = rhs_h*oneocp
1393 dtcondtem(i,km1) = - elocp * dqcondtem(i,km1) + dtfrztem(i,km1)
1405 condtermt(i,k) = condtermt(i,k) + dtcondtem(i,k) * delpinv(i,k)
1406 condtermq(i,k) = condtermq(i,k) + dqcondtem(i,k) * delpinv(i,k)
1407 prectermq(i,k) = prectermq(i,k) + dqprectem(i,k) * delpinv(i,k)
1408 prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv(i,k)
1409 frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv(i,k)
1429 CALL cumdwn(im, ijsdim, kmax, ntr, ntrq, nctp, &
1430 gtt , gtq , gtu , gtv , &
1432 gprcp , gsnwp , gtevp , gmdd , &
1434 gdh , gdw , gdq , gdq(:,:,iti) , &
1435 gdqs , gds , gdhs , gdt , &
1437 gdzm , fdqs , delp , delpinv , &
1438 sigmad, do_aw , do_awdd, flx_form, &
1439 dtmelt, dtevap, dtsubl, &
1440 dtdwn , dqvdwn, dqldwn, dqidwn, &
1442 kb , ktmxt , ists , iens )
1448 if (.not. flx_form)
then
1451 CALL cumsbh(im , ijsdim, kmax , ntr , ntrq , &
1454 gdh , gdq , gdq(:,:,iti) , &
1456 delpinv , gmflx , gmfx0 , &
1457 ktmxt , cpres , kb, ists , iens )
1459 CALL cumsbw(im , ijsdim, kmax , &
1462 delpinv , gmflx , gmfx0 , &
1463 ktmxt , cpres , kb, ists , iens )
1469 if (.not. flx_form)
then
1472 allocate (gprcc(ijsdim,ntr))
1478 CALL cumupr(im , ijsdim, kmax , ntr , &
1481 gcym , gcyt , gcqt , gclt , gcit , &
1482 gtprt , gtevp , gtprc0, &
1483 kb , kbmx , kt , ktmx , ktmxt , &
1484 delpinv , otspt1, ists , iens, &
1485 fscav , fswtr, nctp)
1489 CALL cumdnr(im ,ijsdim , kmax , ntr , &
1491 gdq , gmdd , delpinv , &
1492 ktmxt , otspt1, ists , iens )
1507 if (.not. otspt2(n))
then
1526 fsigma(i,k) = one - half*(sigma(i,k)+sigma(i,kp1))
1541 gsnwp( i,kp1 ) = zero
1542 gprcp( i,kp1 ) = zero
1544 tem1 = cpoemelt/grav
1550 tem = -dtmelt(i,k) * delp(i,k) * tem1
1551 teme = -dtevap(i,k) * delp(i,k) * tem2
1552 tems = -dtsubl(i,k) * delp(i,k) * tem3
1553 gsnwp(i,k) = gsnwp(i,kp1) + fsigma(i,k) * (gsnwi(i,k) - tem - tems)
1554 gprcp(i,k) = gprcp(i,kp1) + fsigma(i,k) * (gprci(i,k) + tem - teme)
1576 dqevap(i,k) = - dtevap(i,k)*cpoel - dtsubl(i,k)*cpoesub
1577 dtevap(i,k) = dtevap(i,k) + dtsubl(i,k)
1586 tem = frzterm(i,k)*cpoemelt - prectermfrz(i,k)
1591 gtt(i,k) = dtdwn(i,k) + condtermt(i,k) &
1592 + fsigma(i,k)*(dtmelt(i,k) + dtevap(i,k))
1593 gtq(i,k,1) = dqvdwn(i,k) + condtermq(i,k) &
1594 + fsigma(i,k) * dqevap(i,k)
1595 gtq(i,k,itl) = dqldwn(i,k) - condtermq(i,k) &
1596 - prectermq(i,k) - tem
1597 gtq(i,k,iti) = dqidwn(i,k) + tem
1608 cbmfl = cbmfx(i,ctp)
1610 if(cbmfl > zero)
then
1613 gtt(i,k) = gtt(i,k) - (fsigma(i,kp1)*sfluxtem(i,kp1,ctp) &
1614 - fsigma(i,k)*sfluxtem(i,k,ctp)) * delpinv(i,k)
1615 gtq(i,k,1) = gtq(i,k,1) - (fsigma(i,kp1)*qvfluxtem(i,kp1,ctp) &
1616 - fsigma(i,k)*qvfluxtem(i,k,ctp)) * delpinv(i,k)
1617 gtq(i,k,itl) = gtq(i,k,itl) - (fsigma(i,kp1)*qlfluxtem(i,kp1,ctp) &
1618 - fsigma(i,k)*qlfluxtem(i,k,ctp)) * delpinv(i,k)
1619 gtq(i,k,iti) = gtq(i,k,iti) - (fsigma(i,kp1)*qifluxtem(i,kp1,ctp) &
1620 - fsigma(i,k)*qifluxtem(i,k,ctp)) * delpinv(i,k)
1627 gtq(i,k,n) = - (fsigma(i,kp1)*trfluxtem(i,kp1,n,ctp) &
1628 - fsigma(i,k)*trfluxtem(i,k,n,ctp)) * delpinv(i,k)
1638 moistening_aw(i) = zero
1645 tem1 = - gdq(i,k,itl)*tem2
1646 if (gtq(i,k,itl) < tem1)
then
1647 tem3 = gtq(i,k,itl) - tem1
1648 gtq(i,k,1) = gtq(i,k,1) + tem3
1650 gtt(i,k) = gtt(i,k) - elocp*tem3
1652 tem1 = - gdq(i,k,iti)*tem2
1653 if (gtq(i,k,iti) < tem1)
then
1654 tem3 = gtq(i,k,iti) - tem1
1655 gtq(i,k,1) = gtq(i,k,1) + tem3
1657 gtt(i,k) = gtt(i,k) - esubocp*tem3
1659 tem1 = - gdq(i,k,1)*tem2
1660 if (gtq(i,k,1) < tem1)
then
1661 gtt(i,k) = gtt(i,k) + elocp*(gtq(i,k,1)-tem1)
1666 moistening_aw(i) = moistening_aw(i) &
1667 + (gtq(i,k,1)+gtq(i,k,itl)+gtq(i,k,iti)) * delp(i,k) * gravi
1676 gtq(i,k,n) = gtq(i,k,n) + dtrdwn(i,k,n)
1695 CALL cumfxr(im , ijsdim, kmax , ntr , &
1697 gdq , delp , delta , ktmxt , imfxr, &
1771 if(gprcp(i,1)+gsnwp(i,1) > 1.e-12_kind_phys)
then
1772 moistening_aw(i) = -moistening_aw(i) / (gprcp(i,1)+gsnwp(i,1))
1774 gprcp(i,:) = gprcp(i,:) * moistening_aw(i)
1775 gsnwp(i,:) = gsnwp(i,:) * moistening_aw(i)
1801 gprcpf( i,k ) = 0.5*( gprcp( i,k )+gprcp( i,k+1 ) )
1802 gsnwpf( i,k ) = 0.5*( gsnwp( i,k )+gsnwp( i,k+1 ) )
1817 gtprp(i,k) = gprcp(i,k) + gsnwp(i,k)
1825 fsigma(i,k) = one - sigma(i,k)
1826 gmfx0( i,k ) = gmfx0( i,k ) * fsigma(i,k)
1827 gmflx( i,k ) = gmflx( i,k ) * fsigma(i,k)
1833 gmfx1( i,k ) = gmfx0( i,k ) - gmflx( i,k )
1837 if (
allocated(gprcc))
deallocate(gprcc)
2055 ( ijsdim, kmax , ntr , ntrq , &
2057 gclz , gciz , gprciz, gsnwiz, &
2058 gcyt , gcht , gcqt , &
2059 gclt , gcit , gtprt , &
2060 gcut , gcvt , gctrt , &
2064 gchb , gcwb , gcub , gcvb , &
2066 gdu , gdv , gdh , gdw , &
2067 gdhs , gdqs , gdt , gdtm , &
2068 gdq , gdqi , gdz , gdzm , &
2069 gdpm , fdqs , gam , gdztr , &
2072 kb , ctp , ists , iens, &
2073 gctm , gcqm , gcwm , gchm, gcwt,&
2074 gclm, gcim , gctrm , lprnt, ipr )
2081 INTEGER,
INTENT(IN) :: IJSDIM, KMAX, NTR, ipr , ntrq
2085 REAL(kind_phys) ACWF (IJSDIM)
2086 REAL(kind_phys) GCLZ (IJSDIM, KMAX)
2087 REAL(kind_phys) GCIZ (IJSDIM, KMAX)
2088 REAL(kind_phys) GPRCIZ(IJSDIM, KMAX+1)
2089 REAL(kind_phys) GSNWIZ(IJSDIM, KMAX+1)
2090 REAL(kind_phys) GCYT (IJSDIM)
2091 REAL(kind_phys) GCHT (IJSDIM)
2092 REAL(kind_phys) GCQT (IJSDIM)
2093 REAL(kind_phys) GCLT (IJSDIM)
2094 REAL(kind_phys) GCIT (IJSDIM)
2095 REAL(kind_phys) GCtrT (IJSDIM, ntrq:ntr)
2096 REAL(kind_phys) GTPRT (IJSDIM)
2097 REAL(kind_phys) GCUT (IJSDIM)
2098 REAL(kind_phys) GCVT (IJSDIM)
2099 REAL(kind_phys) GCwT (IJSDIM)
2102 REAL(kind_phys) WCV (IJSDIM, KMAX+1)
2105 REAL(kind_phys) GCYM (IJSDIM, KMAX)
2108 REAL(kind_phys) GCHB (IJSDIM)
2109 REAL(kind_phys) GCWB (IJSDIM)
2110 REAL(kind_phys) GCUB (IJSDIM)
2111 REAL(kind_phys) GCVB (IJSDIM)
2112 REAL(kind_phys) GCIB (IJSDIM)
2113 REAL(kind_phys) GCtrB (IJSDIM,ntrq:ntr)
2114 REAL(kind_phys) GDU (IJSDIM, KMAX)
2115 REAL(kind_phys) GDV (IJSDIM, KMAX)
2116 REAL(kind_phys) GDH (IJSDIM, KMAX)
2117 REAL(kind_phys) GDW (IJSDIM, KMAX)
2118 REAL(kind_phys) GDHS (IJSDIM, KMAX)
2119 REAL(kind_phys) GDQS (IJSDIM, KMAX)
2120 REAL(kind_phys) GDT (IJSDIM, KMAX)
2121 REAL(kind_phys) GDTM (IJSDIM, KMAX+1)
2122 REAL(kind_phys) GDQ (IJSDIM, KMAX, NTR)
2123 REAL(kind_phys) GDQI (IJSDIM, KMAX)
2124 REAL(kind_phys) GDZ (IJSDIM, KMAX)
2125 REAL(kind_phys) GDZM (IJSDIM, KMAX+1)
2126 REAL(kind_phys) GDPM (IJSDIM, KMAX+1)
2127 REAL(kind_phys) FDQS (IJSDIM, KMAX)
2128 REAL(kind_phys) GAM (IJSDIM, KMAX)
2129 REAL(kind_phys) GDZTR (IJSDIM)
2130 REAL(kind_phys) CPRES
2131 REAL(kind_phys) WCB(ijsdim)
2134 INTEGER CTP, ISTS, IENS
2137 REAL(kind_phys) ACWFK (IJSDIM,KMAX)
2138 REAL(kind_phys) ACWFN (IJSDIM,KMAX)
2139 REAL(kind_phys) myGCHt
2140 REAL(kind_phys) GCHMZ (IJSDIM, KMAX)
2141 REAL(kind_phys) GCWMZ (IJSDIM, KMAX)
2142 REAL(kind_phys) GCUMZ (IJSDIM, KMAX)
2143 REAL(kind_phys) GCVMZ (IJSDIM, KMAX)
2144 REAL(kind_phys) GCqMZ (IJSDIM )
2145 REAL(kind_phys) GCIMZ (IJSDIM, KMAX)
2146 REAL(kind_phys) GCtrMZ(IJSDIM, KMAX,ntrq:ntr)
2147 REAL(kind_phys) GTPRMZ(IJSDIM, KMAX)
2149 REAL(kind_phys) BUOY (IJSDIM, KMAX)
2150 REAL(kind_phys) BUOYM (IJSDIM, KMAX)
2151 REAL(kind_phys) WCM (IJSDIM )
2154 REAL(kind_phys) GCY (IJSDIM, KMAX)
2156 REAL(kind_phys) ELAR
2158 REAL(kind_phys) GCHM (IJSDIM, KMAX+1)
2159 REAL(kind_phys) GCWM (IJSDIM, KMAX+1)
2160 REAL(kind_phys) GCTM (IJSDIM, KMAX+1)
2161 REAL(kind_phys) GCQM (IJSDIM, KMAX+1)
2162 REAL(kind_phys) GCLM (IJSDIM, KMAX+1)
2163 REAL(kind_phys) GCIM (IJSDIM, KMAX+1)
2164 REAL(kind_phys) GCUM (IJSDIM, KMAX)
2165 REAL(kind_phys) GCVM (IJSDIM, KMAX)
2166 REAL(kind_phys) GCtrM (IJSDIM, KMAX,ntrq:ntr)
2168 REAL(kind_phys),
dimension(IJSDIM) :: WCM_, ELARM1, GDZMKB
2169 REAL(kind_phys) GDQSM, GDHSM, GDQM, GDSM, GDCM, FDQSM, GCCM, &
2170 DELZ, ELADZ, DCTM , CPGMI, DELC, FICE, ELARM2,GCCMZ, &
2171 PRECR, GTPRIZ, DELZL, GCCT, DCT, WCVX, PRCZH, wrk
2172 INTEGER K, I, kk, km1, kp1, n
2189 REAL(kind_phys),
parameter :: ZTREF = 1._kind_phys, ztrefi = one/ztref, &
2190 elamin = zero, elamax = 4.e-3
2191 REAL(kind_phys) :: PB = 1.0_kind_phys
2193 REAL(kind_phys) :: TAUZ = 1.0e4_kind_phys
2198 REAL(kind_phys) :: WCCRT = 1.0e-6_kind_phys, wvcrt=1.0e-3_kind_phys
2199 REAL(kind_phys) :: TSICE = 273.15_kind_phys
2200 REAL(kind_phys) :: TWICE = 233.15_kind_phys
2201 REAL(kind_phys) :: c1t
2204 REAL(kind_phys) :: wfn_neg = 0.15
2209 REAL(kind_phys) :: esat, tem
2213 REAL(kind_phys) FPREC
2214 REAL(kind_phys) FRICE
2219 fprec(z,zh) = min(max(one-exp(-(z-precz0)/zh), zero), one)
2220 frice(t) = min(max((tsice-t)/(tsice-twice), zero), one)
2244 wcv(i,k) = unset_kind_phys
2245 gclm(i,k) = unset_kind_phys
2246 gcim(i,k) = unset_kind_phys
2251 acwfk(i,k) = unset_kind_phys
2252 acwfn(i,k) = unset_kind_phys
2263 buoy(i,k) = unset_kind_phys
2264 buoym(i,k) = unset_kind_phys
2265 gcy(i,k) = unset_kind_phys
2267 gchm(i,k) = unset_kind_phys
2268 gcwm(i,k) = unset_kind_phys
2269 gctm(i,k) = unset_kind_phys
2270 gcqm(i,k) = unset_kind_phys
2271 gcum(i,k) = unset_kind_phys
2272 gcvm(i,k) = unset_kind_phys
2277 wcm(i) = unset_kind_phys
2287 gctrm(i,k,n) = unset_kind_phys
2303 gdzmkb(i) = gdzm(i,k)
2310 gctrm(i,k,n) = gctrb(i,n)
2313 esat = min(gdpm(i,k), fpvs(gdtm(i,k)))
2314 gdqsm = min(epsv*esat/max(gdpm(i,k)+epsvm1*esat, 1.0e-10), 0.1)
2315 gdsm = cp*gdtm(i,k) + grav*gdzmkb(i)
2316 gdhsm = gdsm + el*gdqsm
2318 tem = one / gdtm(i,k)
2319 fdqsm = gdqsm * tem * (fact1 + fact2*tem)
2321 tem = one / (cp+el*fdqsm)
2322 dctm = (gchb(i) - gdhsm) * tem
2323 gcqm(i,k) = min(gdqsm + fdqsm*dctm, gcwm(i,k))
2324 gccm = max(gcwm(i,k)-gcqm(i,k), zero)
2327 gctm(i,k) = (gchb(i) - grav*gdzm(i,k) - el*gcqm(i,k)) * oneocp + dctm
2329 gcim(i,k) = frice(gctm(i,k)) * gccm
2330 gclm(i,k) = max(gccm-gcim(i,k), zero)
2331 gchm(i,k) = gchm(i,k) + emelt * (gcim(i,k)-gcib(i))
2332 dctm = (gchm(i,k) - gdhsm) * tem
2334 gctm(i,k) = dctm + (gchb(i) - el*gcqm(i,k)) * oneocp
2336 gdqm = half * (gdq(i,k,1) + gdq(i,k-1,1))
2337 gdcm = half * (gdq(i,k,itl) + gdqi(i,k) &
2338 + gdq(i,k-1,itl) + gdqi(i,k-1))
2341 buoym(i,k) = (dctm*tem + epsvt*(gcqm(i,k)-gdqm) - gccm + gdcm )*grav
2356 gchmz(i,k) = gchm(i,k)
2357 gcwmz(i,k) = gcwm(i,k)
2358 gcumz(i,k) = gcum(i,k)
2359 gcvmz(i,k) = gcvm(i,k)
2360 gcqmz(i) = gcqm(i,k)
2361 gcimz(i,k) = gcim(i,k)
2363 gctrmz(i,k,n) = gctrm(i,k,n)
2373 IF (kb(i) > 0 .and. k > kb(i) .AND. wcm_(i) > wccrt)
THEN
2374 wcv(i,km1) = sqrt(max(wcm_(i), zero))
2375 delz = gdzm(i,k) - gdzm(i,km1)
2376 elarm1(i) = min(max(clmdpa*buoym(i,km1)/wcm_(i), elamin), elamax)
2377 gcym(i,k) = gcym(i,km1) * exp(elarm1(i)*delz)
2378 eladz = gcym(i,k) - gcym(i,km1)
2380 gchmz(i,k) = gchmz(i,km1) + gdh(i,km1)*eladz
2381 gcwmz(i,k) = gcwmz(i,km1) + gdw(i,km1)*eladz
2383 esat = min(gdpm(i,k), fpvs(gdtm(i,k)))
2384 gdqsm = min(epsv*esat/max(gdpm(i,k)+epsvm1*esat, 1.0e-10), 0.1)
2385 gdhsm = cp*gdtm(i,k ) + grav*gdzm(i,k) + el*gdqsm
2387 tem = one / gdtm(i,k)
2388 fdqsm = gdqsm * tem * (fact1 + fact2*tem)
2389 cpgmi = one / (cp + el*fdqsm)
2392 wrk = one / gcym(i,k)
2393 dctm = (gchmz(i,k)*wrk - gdhsm) * cpgmi
2394 gcqmz(i) = min((gdqsm+fdqsm*dctm)*gcym(i,k), gcwmz(i,k))
2395 if(preczh > zero)
then
2396 prczh = preczh * min(gdztr(i)*ztrefi, one)
2397 precr = fprec(gdzm(i,k)-gdzmkb(i), prczh )
2398 gtprmz(i,k) = precr * (gcwmz(i,k)-gcqmz(i))
2400 delc=gdz(i,k)-gdz(i,km1)
2401 if(gdtm(i,k)>tsice)
then
2404 c1t=c0t*exp(d0t*(gdtm(i,k)-tsice))*delc
2407 gtprmz(i,k) = c1t * (gcwmz(i,k)-gcqmz(i))
2409 gtprmz(i,k) = max(gtprmz(i,k), gtprmz(i,km1))
2410 gccmz = gcwmz(i,k) - gcqmz(i) - gtprmz(i,k )
2411 delc = min(gccmz, zero)
2412 gccmz = gccmz - delc
2413 gcqmz(i) = gcqmz(i) + delc
2415 fice = frice(gdtm(i,k)+dctm )
2416 gcimz(i,k) = fice * gccmz
2417 gsnwiz(i,km1) = fice * (gtprmz(i,k)-gtprmz(i,km1))
2418 gchmz(i,k) = gchmz(i,k) + emelt * (gcimz(i,k) + gsnwiz(i,km1) &
2419 - gcimz(i,km1) - gdqi(i,km1)*eladz)
2420 dctm = (gchmz(i,k)*wrk - gdhsm) * cpgmi
2422 gdqm = half * (gdq(i,k,1) + gdq(i,km1,1))
2423 gdcm = half * (gdq(i,k,itl) + gdqi(i,k) &
2424 + gdq(i,km1,itl) + gdqi(i,km1))
2425 gcqm(i,k) = wrk * gcqmz(i)
2428 buoym(i,k) = (dctm*tem + epsvt*(gcqm(i,k)-gdqm)-gccm+gdcm) * grav
2429 buoy(i,km1) = half * (buoym(i,k)+buoym(i,km1))
2442 IF (buoy(i,km1) > zero)
THEN
2443 wcm(i) = (wcm_(i) + clmp*delz*buoy(i,km1)) / (one + delz/tauz)
2445 wcm(i) = (wcm_(i) + pa*(delz+delz)*buoy(i,km1) ) &
2446 / (one + delz/tauz + (delz+delz)*elamin )
2457 if (wcm(i) > zero)
then
2458 elarm2 = min(max(clmdpa*buoym(i,k)/wcm(i),elamin), elamax)
2462 elar = half * (elarm1(i) + elarm2)
2463 gcym(i,k) = gcym(i,km1) * exp(elar*delz)
2464 eladz = gcym(i,k) - gcym(i,km1)
2466 gchmz(i,k) = gchmz(i,km1) + gdh(i,km1)*eladz
2467 gcwmz(i,k) = gcwmz(i,km1) + gdw(i,km1)*eladz
2468 gcumz(i,k) = gcumz(i,km1) + gdu(i,km1)*eladz
2469 gcvmz(i,k) = gcvmz(i,km1) + gdv(i,km1)*eladz
2471 gctrmz(i,k,n) = gctrmz(i,km1,n) + gdq(i,km1,n)*eladz
2474 wrk = one / gcym(i,k)
2475 dctm = (gchmz(i,k)*wrk - gdhsm) * cpgmi
2476 gcqmz(i) = min((gdqsm+fdqsm*dctm)*gcym(i,k), gcwmz(i,k))
2477 if(preczh > zero)
then
2478 gtprmz(i,k) = precr * (gcwmz(i,k)-gcqmz(i))
2480 gtprmz(i,k) = c1t * (gcwmz(i,k)-gcqmz(i))
2482 gtprmz(i,k) = max(gtprmz(i,k), gtprmz(i,km1))
2483 gccmz = gcwmz(i,k) - gcqmz(i) - gtprmz(i,k)
2484 delc = min(gccmz, zero)
2485 gccmz = gccmz - delc
2486 gcqmz(i) = gcqmz(i) + delc
2488 gcqm(i,k) = wrk * gcqmz(i)
2490 fice = frice(gdtm(i,k)+dctm )
2491 gcimz(i,k) = fice*gccmz
2492 gcim(i,k) = gcimz(i,k)*wrk
2493 gclm(i,k) = max(gccm-gcim(i,k), zero)
2494 gtpriz = gtprmz(i,k) - gtprmz(i,km1)
2495 gsnwiz(i,km1) = fice*gtpriz
2497 gprciz(i,km1) = (one-fice )*gtpriz
2498 gchmz(i,k) = gchmz(i,k) + emelt*(gcimz(i,k) + gsnwiz(i,km1) &
2499 - gcimz(i,km1) - gdqi(i,km1)*eladz )
2500 gchm(i,k) = gchmz(i,k)*wrk
2501 dctm = (gchm(i,k)-gdhsm) * cpgmi
2503 gctm(i,k) = dctm + (gchm(i,k) - el*gcqm(i,k)) * oneocp
2505 gcwm(i,k) = gcwmz(i,k) * wrk
2506 gcum(i,k) = gcumz(i,k) * wrk
2507 gcvm(i,k) = gcvmz(i,k) * wrk
2509 gctrm(i,k,n) = gctrmz(i,k,n) * wrk
2511 delzl = gdz(i,km1)-gdzm(i,km1)
2512 gcy(i,km1) = gcym(i,km1) * exp(elar*delzl)
2513 gclz(i,km1) = half * (gclm(i,k) + gclm(i,km1)) * gcy(i,km1)
2514 gciz(i,km1) = half * (gcim(i,k) + gcim(i,km1)) * gcy(i,km1)
2517 buoym(i,k) = (dctm*tem + epsvt*(gcqm(i,k)-gdqm)-gccm+gdcm) * grav
2518 buoy(i,km1) = half * (buoym(i,k)+buoym(i,km1))
2520 IF (buoy(i,km1) > zero)
THEN
2521 wcm(i) = (wcm_(i) + clmp*delz*buoy(i,km1)) / (one + delz/tauz)
2523 wcm(i) = (wcm_(i) + pa*(delz+delz)*buoy(i,km1) ) &
2524 / (one + delz/tauz + (delz+delz)*elamin )
2538 wrk = buoy(i,km1)*gcy(i,km1)*delz
2539 acwfk(i,k) = acwfk(i,km1) + wrk
2540 acwfn(i,k) = acwfn(i,km1) - min(wrk,0.0)
2557 if (kb(i) > 0 .and. k > kb(i) .and. acwfk(i,k) > 1.0e-10)
then
2558 wrk = acwfn(i,k) / acwfk(i,k)
2559 IF (kt(i) == -1 .and. wrk < wfn_neg .AND. wcv(i,k) > wvcrt)
THEN
2561 acwf(i) = acwfk(i,k)
2570 kt(i) = min(kt(i), kmax-1)
2571 ktmx = max(ktmx, kt(i))
2575 kk = max(1, kt(i)+1)
2589 IF (kb(i) > 0 .and. kt(i) > kb(i))
THEN
2593 eladz = gcyt(i) - gcym(i,k)
2595 gcht(i) = gchmz(i,k) + gdh(i,k)*eladz
2596 gcwt(i) = gcwmz(i,k) + gdw(i,k)*eladz
2597 gcut(i) = gcumz(i,k) + gdu(i,k)*eladz
2598 gcvt(i) = gcvmz(i,k) + gdv(i,k)*eladz
2600 gctrt(i,n) = gctrmz(i,k,n) + gdq(i,k,n)*eladz
2604 dct = (gcht(i)*wrk - gdhs(i,k)) / (cp*(one + gam(i,k)))
2605 gcqt(i) = min((gdqs(i,k) + fdqs(i,k)*dct) * gcyt(i), gcwt(i))
2606 if(preczh > zero)
then
2607 prczh = preczh * min(gdztr(i)*ztrefi, one)
2608 gtprt(i) = fprec(gdz(i,k)-gdzmkb(i), prczh) * (gcwt(i)-gcqt(i))
2610 delc=gdz(i,k)-gdz(i,k-1)
2611 if(gdtm(i,k)>tsice)
then
2614 c1t=c0t*exp(d0t*(gdtm(i,k)-tsice))*delc
2617 gtprt(i) = c1t * (gcwt(i)-gcqt(i))
2619 gtprt(i) = max(gtprt(i), gtprmz(i,k))
2620 gcct = gcwt(i) - gcqt(i) - gtprt(i)
2621 delc = min(gcct, zero)
2623 gcqt(i) = gcqt(i) + delc
2625 fice = frice(gdt(i,k)+dct)
2627 gclt(i) = (one-fice) * gcct
2628 gtpriz = gtprt(i) - gtprmz(i,k)
2629 gprciz(i,k) = (one-fice) * gtpriz
2630 gsnwiz(i,k) = fice * gtpriz
2632 + emelt * (gcit(i) + gsnwiz(i,k) - gcimz(i,k) - gdqi(i,k)*eladz)
2634 gcut(i) = gcut(i)*(one-cpres) + gcy(i,k)*gdu(i,k)*cpres
2635 gcvt(i) = gcvt(i)*(one-cpres) + gcy(i,k)*gdv(i,k)*cpres
2638 gctrt(i,n) = gctrt(i,n) + gcy(i,k)*gdq(i,k,n)
2644 mygcht = gcht(i) - el*(gcwt(i) - gcqt(i))
2646 gctm(i,kp1) = wrk * (mygcht - el*gcqt(i)) * oneocp
2648 gcqm(i,kp1) = gcqt(i)*wrk
2649 gcim(i,kp1) = gcit(i)*wrk
2650 gclm(i,kp1) = gclt(i)*wrk
2652 gctrm(i,kp1,n) = gctrt(i,n)*wrk
3142 ( im , ijsdim, kmax , ntr,ntrq,nctp, &
3143 gtt , gtq , gtu , gtv , &
3145 gprcp , gsnwp , gtevp , gmdd , &
3147 gdh , gdw , gdq , gdqi , &
3148 gdqs , gds , gdhs , gdt , &
3150 gdzm , fdqs , delp , &
3152 sigmad, do_aw , do_awdd, flx_form, &
3153 gtmelt, gtevap, gtsubl, &
3154 dtdwn , dqvdwn, dqldwn, dqidwn, &
3156 kb , ktmx , ists , iens )
3162 INTEGER,
INTENT(IN) :: IM, IJSDIM, KMAX, NTR , ntrq, nctp
3163 logical,
intent(in) :: do_aw, do_awdd, flx_form
3166 REAL(kind_phys) GTT (IJSDIM, KMAX)
3167 REAL(kind_phys) GTQ (IJSDIM, KMAX, NTR)
3168 REAL(kind_phys) GTU (IJSDIM, KMAX)
3169 REAL(kind_phys) GTV (IJSDIM, KMAX)
3170 REAL(kind_phys) GMFLX (IJSDIM, KMAX+1)
3173 REAL(kind_phys) GPRCP (IJSDIM, KMAX+1)
3174 REAL(kind_phys) GSNWP (IJSDIM, KMAX+1)
3175 REAL(kind_phys) GTEVP (IJSDIM, KMAX)
3176 REAL(kind_phys) GMDD (IJSDIM, KMAX+1)
3179 REAL(kind_phys) gtmelt (IJSDIM, KMAX)
3180 REAL(kind_phys) gtevap (IJSDIM, KMAX)
3181 REAL(kind_phys) gtsubl (IJSDIM, KMAX)
3183 REAL(kind_phys) dtdwn (IJSDIM, KMAX)
3184 REAL(kind_phys) dqvdwn (IJSDIM, KMAX)
3185 REAL(kind_phys) dqldwn (IJSDIM, KMAX)
3186 REAL(kind_phys) dqidwn (IJSDIM, KMAX)
3187 REAL(kind_phys) dtrdwn (IJSDIM, KMAX, ntrq:ntr)
3190 REAL(kind_phys) GPRCI (IJSDIM, KMAX)
3191 REAL(kind_phys) GSNWI (IJSDIM, KMAX)
3192 REAL(kind_phys) GDH (IJSDIM, KMAX)
3193 REAL(kind_phys) GDW (IJSDIM, KMAX)
3194 REAL(kind_phys) GDQ (IJSDIM, KMAX, NTR)
3195 REAL(kind_phys) GDQI (IJSDIM, KMAX)
3196 REAL(kind_phys) GDQS (IJSDIM, KMAX)
3197 REAL(kind_phys) GDS (IJSDIM, KMAX)
3198 REAL(kind_phys) GDHS (IJSDIM, KMAX)
3199 REAL(kind_phys) GDT (IJSDIM, KMAX)
3200 REAL(kind_phys) GDU (IJSDIM, KMAX)
3201 REAL(kind_phys) GDV (IJSDIM, KMAX)
3202 REAL(kind_phys) GDZ (IJSDIM, KMAX)
3203 REAL(kind_phys) GDZM (IJSDIM, KMAX+1)
3204 REAL(kind_phys) FDQS (IJSDIM, KMAX)
3205 REAL(kind_phys) DELP (IJSDIM, KMAX)
3206 REAL(kind_phys) DELPI (IJSDIM, KMAX)
3208 INTEGER KTMX, ISTS, IENS
3209 REAL(kind_phys) sigmad (IM,KMAX+1)
3214 REAL(kind_phys) EVAPD (IJSDIM, KMAX)
3215 REAL(kind_phys) SUBLD (IJSDIM, KMAX)
3216 REAL(kind_phys) EVAPE (IJSDIM, KMAX)
3217 REAL(kind_phys) SUBLE (IJSDIM, KMAX)
3218 REAL(kind_phys) EVAPX (IJSDIM, KMAX)
3219 REAL(kind_phys) SUBLX (IJSDIM, KMAX)
3220 REAL(kind_phys) GMDDE (IJSDIM, KMAX)
3221 REAL(kind_phys) SNMLT (IJSDIM, KMAX)
3222 REAL(kind_phys) GCHDD (IJSDIM, KMAX)
3223 REAL(kind_phys) GCWDD (IJSDIM, KMAX)
3224 REAL(kind_phys) GTTEV (IJSDIM, KMAX)
3225 REAL(kind_phys) GTQEV (IJSDIM, KMAX)
3226 REAL(kind_phys) GCHD (ISTS:IENS)
3227 REAL(kind_phys) GCWD (ISTS:IENS)
3229 REAL(kind_phys) GCdseD(ISTS:IENS, KMAX)
3230 REAL(kind_phys) GCqvD (ISTS:IENS, KMAX)
3231 REAL(kind_phys) GCqlD (ISTS:IENS, KMAX)
3232 REAL(kind_phys) GCqiD (ISTS:IENS, KMAX)
3233 REAL(kind_phys) GCtrD (ISTS:IENS, ntrq:ntr)
3235 REAL(kind_phys) GCUD (ISTS:IENS)
3236 REAL(kind_phys) GCVD (ISTS:IENS)
3237 REAL(kind_phys) FSNOW (ISTS:IENS)
3238 REAL(kind_phys) GMDDD (ISTS:IENS)
3240 REAL(kind_phys) GDTW
3241 REAL(kind_phys) GCHX, GCTX, GCQSX, GTPRP, EVSU, GTEVE, LVIC
3242 REAL(kind_phys) DQW, DTW, GDQW, DZ, GCSD, FDET, GDHI
3243 REAL(kind_phys) GMDDX, GMDDMX
3244 REAL(kind_phys) GCHDX, GCWDX
3245 REAL(kind_phys) GCUDD, GCVDD
3246 REAL(kind_phys) GTHCI, GTQVCI, GTQLCI, GTQICI
3248 real(kind_phys) wrk, fmelt, fevp, gctrdd(ntrq:ntr)
3250 REAL(kind_phys) WBGT ( ISTS:IENS )
3251 REAL(kind_phys) HBGT ( ISTS:IENS )
3252 REAL(kind_phys) DDWBGT( ISTS:IENS )
3253 REAL(kind_phys) DDHBGT( ISTS:IENS )
3254 REAL(kind_phys) WMX, HMX, DDWMX, DDHMX, tx1, wrk1, wrk2, wrk3, wrk4, wrkn
3255 REAL(kind_phys) dp_above, dp_below
3256 real(kind_phys) fsigma
3261 REAL(kind_phys),
parameter :: TWSNOW = 273.15_kind_phys
3262 REAL(kind_phys),
parameter :: FTMLT = 4._kind_phys
3263 REAL(kind_phys),
parameter :: GMFLXC = 5.e-2_kind_phys
3264 REAL(kind_phys),
parameter :: VTERMS = 2._kind_phys
3266 REAL(kind_phys),
parameter :: MELTAU = 20._kind_phys
3269 REAL(kind_phys),
parameter :: EVAPR = 0.3_kind_phys
3271 REAL(kind_phys),
parameter :: REVPDD = 1._kind_phys
3272 REAL(kind_phys),
parameter :: RDDR = 5.e-4_kind_phys
3274 REAL(kind_phys),
parameter :: RDDMX = 0.5_kind_phys
3275 REAL(kind_phys),
parameter :: VTERM = 5._kind_phys
3277 REAL(kind_phys),
parameter :: EVATAU = 2._kind_phys
3278 REAL(kind_phys),
parameter :: ZDMIN = 5.e2_kind_phys
3279 real(kind_phys),
parameter :: evapovtrm=evapr/vterm
3352 gtprp = gprcp(i,kp1) + gsnwp(i,kp1)
3353 IF (gtprp > zero)
THEN
3354 fsnow(i) = gsnwp(i,kp1) / gtprp
3358 lvic = elocp + emeltocp*fsnow(i)
3359 gdtw = gdt(i,k) - lvic*(gdqs(i,k) - gdq(i,k,1)) &
3360 / (one + lvic*fdqs(i,k))
3362 dz = gdzm(i,kp1) - gdzm(i,k)
3363 fmelt = (one + ftmlt*(gdtw - twsnow)) &
3364 * (one - tanh(gmflx(i,kp1)/gmflxc)) &
3365 * (one - tanh(vterms*meltau/dz))
3366 IF (gdtw < twsnow)
THEN
3367 snmlt(i,k) = gprcp(i,kp1)*min(max(fmelt, one), zero)
3369 snmlt(i,k) = gsnwp(i,kp1)*max(min(fmelt, one), zero)
3371 gsnwp(i,k) = gsnwp(i,kp1)+gsnwi(i,k) - snmlt(i,k)
3372 gprcp(i,k) = gprcp(i,kp1)+gprci(i,k) + snmlt(i,k)
3373 gttev(i,k) = -emeltocp * snmlt(i,k) * delpi(i,k)
3375 gtmelt(i,k) = gtmelt(i,k) + gttev(i,k)
3385 dz = gdzm(i,kp1) - gdzm(i,k)
3386 fevp = (one - tanh(evatau*vterm/dz))
3387 IF (gmdd(i,kp1) > zero)
THEN
3388 gchx = gchd(i) / gmdd(i,kp1)
3389 gctx = gdt(i,k) + (gchx-gdhs(i,k)) / (cp+el*fdqs(i,k))
3390 gcqsx = gdqs(i,k) + fdqs(i,k) * (gctx - gdt(i,k))
3391 gcqsx = gcqsx*gmdd(i,kp1)
3392 evsu = max(gcqsx-gcwd(i), zero) * fevp
3393 gtprp = gprcp(i,k) + gsnwp(i,k)
3394 IF (gtprp > zero)
THEN
3395 fsnow(i) = gsnwp(i,k) / gtprp
3399 evapd(i,k) = min(evsu*(one-fsnow(i)), gprcp(i,k))
3400 subld(i,k) = min(evsu*fsnow(i), gsnwp(i,k))
3401 gprcp(i,k) = gprcp(i,k) - evapd(i,k)
3402 gsnwp(i,k) = gsnwp(i,k) - subld(i,k)
3405 gtevap(i,k) = gtevap(i,k) - elocp * evapd(i,k) * wrk
3406 gtsubl(i,k) = gtsubl(i,k) - esubocp * subld(i,k) * wrk
3407 gcwd(i) = gcwd(i) + evapd(i,k) + subld(i,k)
3408 gchd(i) = gchd(i) - emelt*subld(i,k)
3411 gmdd(i,k) = gmdd(i,kp1)
3413 lvic = elocp + emeltocp*fsnow(i)
3414 dqw = (gdqs(i,k) - gdw(i,k)) / (one + lvic*fdqs(i,k))
3415 dqw = max(dqw, zero)
3417 gdqw = gdw(i,k) + dqw*fevp
3419 evsu = min(one, evapovtrm*dqw*dz*fevp)
3420 evape(i,k) = evsu*gprcp(i,k)
3421 suble(i,k) = evsu*gsnwp(i,k)
3422 gtevp(i,k) = evapd(i,k) + subld(i,k) + evape(i,k) + suble(i,k)
3424 gtprp = gprcp(i,k) + gsnwp(i,k)
3425 gprcp(i,k) = gprcp(i,k) - evape(i,k)
3426 gsnwp(i,k) = gsnwp(i,k) - suble(i,k)
3429 gtevap(i,k) = gtevap(i,k) - el*evape(i,k) * wrk1
3430 gtsubl(i,k) = gtsubl(i,k) - (el+emelt)*suble(i,k) * wrk1
3433 IF (gdz(i,k)-gdzm(i,1) > zdmin)
THEN
3434 gteve = evape(i,k) + suble(i,k)
3435 gmddmx = revpdd*gteve/max(dqw, 1.d-10)
3436 gmdde(i,k) = rddr * (dtw*gtprp*delp(i,k))
3437 gmdde(i,k) = max(min(gmdde(i,k), gmddmx), zero)
3438 gmddx = gmdd(i,kp1) + gmdde(i,k)
3439 evsu = gmdde(i,k)*dqw*fevp
3440 IF (gteve > zero)
THEN
3441 fsnow(i) = suble(i,k) / gteve
3445 evapx(i,k) = (one-fsnow(i)) * evsu
3446 sublx(i,k) = fsnow(i) * evsu
3448 IF (gmddx > zero)
THEN
3449 gdhi = gdh(i,k) - emelt*gdqi(i,k)
3450 gchdx = gchd(i) + gdhi*gmdde(i,k) - emelt*sublx(i,k)
3451 gcwdx = gcwd(i) + gdqw*gmdde(i,k)
3452 gcsd = (gchdx - el*gcwdx) / gmddx
3453 IF (gcsd < gds(i,k))
THEN
3456 gcud(i) = gcud(i) + gdu(i,k)*gmdde(i,k)
3457 gcvd(i) = gcvd(i) + gdv(i,k)*gmdde(i,k)
3459 gctrd(i,n) = gctrd(i,n) + gdq(i,k,n)*gmdde(i,k)
3462 evape(i,k) = evape(i,k) - evapx(i,k)
3463 suble(i,k) = suble(i,k) - sublx(i,k)
3464 evapd(i,k) = evapd(i,k) + evapx(i,k)
3465 subld(i,k) = subld(i,k) + sublx(i,k)
3469 gmddd(i) = gmdd(i,kp1)
3473 gmddd(i) = dz / (gdzm(i,kp1)-gdzm(i,1)) * gmdd(i,kp1)
3476 gmddd(i) = max(gmddd(i), gmdd(i,k)-rddmx*gmflx(i,k))
3478 IF (gmddd(i) > zero)
THEN
3479 fdet = gmddd(i)/gmdd(i,k)
3480 gchdd(i,k) = fdet*gchd(i)
3481 gcwdd(i,k) = fdet*gcwd(i)
3482 gcudd = fdet*gcud(i)
3483 gcvdd = fdet*gcvd(i)
3485 gctrdd(n) = fdet*gctrd(i,n)
3488 gthci = wrk * (gchdd(i,k) - gmddd(i)*gdh(i,k))
3489 gtqvci = wrk * (gcwdd(i,k) - gmddd(i)*gdq(i,k,1))
3491 gtt(i,k) = gtt(i,k) + (gthci - el*gtqvci)*oneocp
3492 gtq(i,k,1) = gtq(i,k,1) + gtqvci
3493 gtq(i,k,itl) = gtq(i,k,itl) - wrk * gmddd(i)*gdq(i,k,itl)
3494 gtq(i,k,iti) = gtq(i,k,iti) - wrk * gmddd(i)*gdqi(i,k)
3497 gtq(i,k,n) = gtq(i,k,n) + wrk * (gctrdd(n) - gmddd(i)*gdq(i,k,n))
3498 gctrd(i,n) = gctrd(i,n) - gctrdd(n)
3501 gtu(i,k) = gtu(i,k) + wrk * (gcudd - gmddd(i)*gdu(i,k))
3502 gtv(i,k) = gtv(i,k) + wrk * (gcvdd - gmddd(i)*gdv(i,k))
3504 gchd(i) = gchd(i) - gchdd(i,k)
3505 gcwd(i) = gcwd(i) - gcwdd(i,k)
3506 gcud(i) = gcud(i) - gcudd
3507 gcvd(i) = gcvd(i) - gcvdd
3508 gmdd(i,k) = gmdd(i,k) - gmddd(i)
3510 gcdsed(i,k) = gchd(i) - el*gcwd(i)
3511 gcqvd(i,k) = gcwd(i)
3524 gttev(i,k) = gttev(i,k) - wrk &
3525 * (elocp*evape(i,k)+(elocp+emeltocp)*suble(i,k))
3526 gtt(i,k) = gtt(i,k) + gttev(i,k)
3528 gtqev(i,k) = gtqev(i,k) + (evape(i,k)+suble(i,k)) * wrk
3529 gtq(i,k,1) = gtq(i,k,1) + gtqev(i,k)
3531 gmflx(i,k) = gmflx(i,k) - gmdd(i,k)
3541 if (k > 1 .and. flx_form)
then
3542 fsigma = one - sigmad(i,kp1)
3543 dp_below = wrk * (one - sigmad(i,k))
3544 dp_above = tx1 * (one - sigmad(i,kp1))
3546 wrk1 = gmdd(i,kp1) * (gdt(i,k)+gocp*gdz(i,k)) - gcdsed(i,kp1)*oneocp
3547 wrk2 = gmdd(i,kp1) * gdq(i,k,1) - gcqvd(i,kp1)
3548 wrk3 = gmdd(i,kp1) * gdq(i,k,itl)
3549 wrk4 = gmdd(i,kp1) * gdqi(i,k)
3551 dtdwn(i,k) = dtdwn(i,k) + dp_below * wrk1
3552 dqvdwn(i,k) = dqvdwn(i,k) + dp_below * wrk2
3553 dqldwn(i,k) = dqldwn(i,k) + dp_below * wrk3
3554 dqidwn(i,k) = dqidwn(i,k) + dp_below * wrk4
3556 dtdwn(i,kp1) = dtdwn(i,kp1) - dp_above * wrk1
3557 dqvdwn(i,kp1) = dqvdwn(i,kp1) - dp_above * wrk2
3558 dqldwn(i,kp1) = dqldwn(i,kp1) - dp_above * wrk3
3559 dqidwn(i,kp1) = dqidwn(i,kp1) - dp_above * wrk4
3561 wrkn = gmdd(i,kp1) * gdq(i,k,n)
3562 dtrdwn(i,k,n) = dtrdwn(i,k,n) + dp_below * wrkn
3563 dtrdwn(i,kp1,n) = dtrdwn(i,kp1,n) - dp_above * wrkn