219 SUBROUTINE myjpbl(NTSD,ME,DT_PHS,EPSL,EPSQ2,HT,STDH,DZ,DEL &
220 ,PMID,PINH,TH,T,EXNER,Q,CWM,U,V &
221 ,TSK,QSFC,CHKLOWQ,THZ0,QZ0,UZ0,VZ0 &
223 ,Q2,EXCH_H,USTAR,Z0,EL_MYJ,PBLH,KPBL,CT &
224 ,AKHS,AKMS,ELFLX,MIXHT,THLM,QLM &
225 ,RUBLTEN,RVBLTEN,RTHBLTEN,RQBLTEN,RQCBLTEN &
226 ,DUSFC,DVSFC,DTSFC,DQSFC,xkzo,xkzmo,ICT &
246 logical(kind=klog),
save:: &
249 INTEGER(KIND=KINT),
INTENT(IN):: &
254 INTEGER,
INTENT(IN) :: ict,me,ntsd
259 INTEGER(KIND=KINT),
DIMENSION(IMS:IME,JMS:JME),
INTENT(OUT):: &
262 REAL(kind=kfpt),
INTENT(IN):: &
266 real(kind=kfpt),
dimension(1:lm-1),
intent(inout):: epsl
267 real(kind=kfpt),
dimension(1:lm),
intent(in):: epsq2
269 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME),
INTENT(IN):: &
272 ,chklowq,elflx,thlm,qlm
274 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM),
INTENT(IN):: &
275 dz,exner,pmid,q,cwm,u,v,t,th,del,xkzo,xkzmo
277 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM+1),
INTENT(IN):: &
280 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME),
INTENT(OUT):: &
284 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM),
INTENT(OUT):: &
287 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM),
INTENT(OUT):: &
292 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME),
INTENT(OUT) :: &
296 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME),
INTENT(INOUT):: &
299 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME),
INTENT(INOUT):: &
304 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM),
INTENT(INOUT):: &
312 INTEGER(KIND=KINT):: &
313 i,iqtb,ittb,j,k,llow,lmh,lmxl
315 INTEGER(KIND=KINT),
DIMENSION(IMS:IME,JMS:JME):: &
319 akhs_dens,akms_dens,bq,bqs00k,bqs10k &
320 ,dcdt,deltaz,dqdt,dtdif,dtdt,dtturbl &
321 ,p00k,p01k,p10k,p11k,pelevfc,pp1,psfc,psp,ptop &
322 ,qbt,qfc1,qlow,qq1,qx &
323 ,rdtturbl,rg,rsqdt,rxners,rxnsfc &
324 ,seamask,sq,sqs00k,sqs10k &
325 ,thbt,thnew,thold,tq,tth &
326 ,ulow,vlow,rstdh,stdfac,zsf,zsx,zsy,zuv
328 REAL(kind=kfpt),
DIMENSION(1:LM):: &
329 cwmk,pk,psk,q2k,qk,rhok,rxnerk,thek,thk,thvk,tk,uk,vk
331 REAL(kind=kfpt),
DIMENSION(1:LM-1):: &
332 akhk,akmk,dcol,el,gh,gm
334 REAL(kind=kfpt),
DIMENSION(1:LM+1):: &
337 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME):: &
340 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM):: &
343 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM-1):: &
346 REAL(kind=kfpt),
DIMENSION(IMS:IME,JMS:JME,1:LM+1):: &
350 REAL(kind=kfpt):: zsl_diag
351 INTEGER(KIND=KINT):: imd,jmd,print_diag
404 zint(i,j,lm+1)=ht(i,j)
411 zint(i,j,k)=zint(i,j,k+1)+dz(i,j,k)
412 rxner(i,j,k)=1./exner(i,j,k)
413 thv(i,j,k)=(q(i,j,k)*0.608+(1.-cwm(i,j,k)))*th(i,j,k)
441 setup_integration:
DO j=jts,jte
453 seamask=xland(i,j)-1.
462 rxnerk(k)=rxner(i,j,k)
476 pelevfc=pmid(i,j,lmh)*elevfc
480 IF(k==lmh .OR. pmid(i,j,k)>pelevfc)
THEN
491 ELSE IF(ittb.GE.jtbl)
THEN
501 bq=(bqs10k-bqs00k)*qq1+bqs00k
502 sq=(sqs10k-sqs00k)*qq1+sqs00k
510 ELSEIF(iqtb.GE.itbl)
THEN
515 p00k=ptbl(iqtb ,ittb )
516 p10k=ptbl(iqtb+1,ittb )
517 p01k=ptbl(iqtb ,ittb+1)
518 p11k=ptbl(iqtb+1,ittb+1)
520 psp=p00k+(p10k-p00k)*pp1+(p01k-p00k)*qq1 &
521 +(p00k-p10k-p01k+p11k)*pp1*qq1
522 rxners=(1.e5/psp)**cappa
523 thek(k)=thbt*exp(elocp*qbt*rxners/thbt)
548 CALL mixlen(lmh,rsqdt,uk,vk,thvk,thek &
549 ,q2k,epsl,epsq2,zhk,pk,psk,rxnerk,gm,gh,el &
550 ,pblh(i,j),lpbl(i,j),lmxl,ct(i,j),mixht(i,j) &
559 CALL prodq2(ntsd,me,lmh,dtturbl,ustar(i,j),gm,gh,el,q2k &
574 CALL difcof(ntsd,me,lmh,lmxl,gm,gh,el,tk,q2k,zhk,akmk,akhk,i,j,lm &
575 ,print_diag,kpbl(i,j))
584 deltaz=0.5*(zhk(k)-zhk(k+2))
585 akhk(k)=max(akhk(k),xkzo(i,j,k)/deltaz)
586 akmk(k)=max(akmk(k),xkzmo(i,j,k)/deltaz)
587 if((thvk(lm)-thvk(k)).GT.0.)
then
588 akhk(k)=max(akhk(k),3./deltaz)
589 akmk(k)=max(akmk(k),3./deltaz)
593 exch_h(i,j,k)=akhk(k)*deltaz
602 CALL vdifq(lmh,dtdif,q2k,el,zhk,i,j,lm)
607 q2(i,j,k)=max(q2k(k),epsq2(k))
608 IF(k<lm)el_myj(i,j,k)=el(k)
615 ENDDO setup_integration
627 thsk(i,j)=tsk(i,j)*(1.e5/psfc)**cappa
643 main_integration:
DO j=jts,jte
655 rhok(k)=pmid(i,j,k)/(r_d*t(i,j,k)*(1.+p608*qk(k)-cwmk(k)))
663 akhk(k)=akh(i,j,k)*0.5*(rhok(k)+rhok(k+1))
666 zhk(lm+1)=zint(i,j,lm+1)
668 seamask=xland(i,j)-1.
669 thz0(i,j)=(1.-seamask)*thsk(i,j)+seamask*thz0(i,j)
672 akhs_dens=akhs(i,j)*rhok(lm)
675 qfc1=xlv*chklowq(i,j)*akhs_dens
677 IF(snow(i,j)>0..OR.sice(i,j)>0.5)
THEN
688 rxnsfc=(1.e5/psfc)**cappa
694 qz0(i,j)=(1.-seamask)*qsfc(i,j)+seamask*qz0(i,j)
703 CALL vdifh(dtdif,lmh,thz0(i,j),qz0(i,j) &
704 ,akhs_dens,chklowq(i,j),ct(i,j) &
705 ,thk,qk,cwmk,akhk,zhk,rhok,i,j,lm)
714 rthblten(i,j,k)=(thk(k)-th(i,j,k))*rdtturbl
715 rqblten(i,j,k)=(qk(k)-q(i,j,k))*rdtturbl
716 rqcblten(i,j,k)=(cwmk(k)-cwm(i,j,k))*rdtturbl
717 dtsfc(i,j)=dtsfc(i,j)+cont*del(i,j,k)*rthblten(i,j,k)*exner(i,j,k)
718 dqsfc(i,j)=dqsfc(i,j)+conq*del(i,j,k)*rqblten(i,j,k)
730 psfc=.01*pinh(i,j,lm+1)
731 zsl_diag=0.5*dz(i,j,lm)
778 seamask=xland(i,j)-1.
780 IF(seamask.LT.0.5.AND.stdh(i,j).GT.1.)
THEN
785 zhk(lm+1)=zint(i,j,lm+1)
786 zsf=stdh(i,j)*stdfac+zhk(lm+1)
794 akmk(k)=akmk(k)*(rhok(k)+rhok(k+1))*0.5
797 akms_dens=akms(i,j)*rhok(lm)
804 zhk(lm+1)=zint(i,j,lm+1)
829 CALL vdifv(lmh,dtdif,uz0(i,j),vz0(i,j) &
830 & ,akms_dens,dcol,uk,vk,akmk,zhk,rhok,i,j,lm)
837 rublten(i,j,k)=(uk(k)-u(i,j,k))*rdtturbl
838 rvblten(i,j,k)=(vk(k)-v(i,j,k))*rdtturbl
839 dusfc(i,j)=dusfc(i,j)+conw*del(i,j,k)*rublten(i,j,k)
840 dvsfc(i,j)=dvsfc(i,j)+conw*del(i,j,k)*rvblten(i,j,k)
846 ENDDO main_integration
864 (lmh,rsqdt,u,v,thv,the,q2,epsl,epsq2,z,p,ps,rxner &
865 ,gm,gh,el,pblh,lpbl,lmxl,ct,mixht,i,j,lm)
872 INTEGER(KIND=KINT),
INTENT(IN):: &
875 REAL(KIND=kfpt),
INTENT(IN):: &
878 INTEGER(KIND=KINT),
INTENT(OUT):: &
881 real(kind=kfpt),
dimension(1:lm-1),
intent(inout):: epsl
882 REAL(KIND=kfpt),
DIMENSION(1:LM),
INTENT(IN):: &
883 p,ps,epsq2,rxner,the,thv,u,v
886 REAL(KIND=kfpt),
DIMENSION(1:LM),
INTENT(INOUT):: q2
888 REAL(KIND=kfpt),
DIMENSION(1:LM+1),
INTENT(IN):: &
891 REAL(KIND=kfpt),
INTENT(OUT):: &
895 REAL(KIND=kfpt),
DIMENSION(1:LM-1),
INTENT(OUT):: &
898 REAL(KIND=kfpt),
INTENT(INOUT):: ct
903 INTEGER(KIND=KINT):: &
907 aden,bden,aubr,bubr,blmx,cubry,dthv,dz &
908 ,el0,eloq2x,ghl,gml &
909 ,qol2st,qol2un,qdzl &
910 ,rdz,sq,srel,szq,vkrmz,wcon
912 REAL(KIND=kfpt),
DIMENSION(1:LM):: &
915 REAL(KIND=kfpt),
DIMENSION(1:LM-1):: &
927 if((thv(lmh)-thv(k)).GT.0.)
then
934 if(q2(k)-epsq2(k)+epsq2(lm).le.epsq2(lm)*fh)
then
944 110 pblh=z(lpbl+1)-z(lmh+1)
954 gml=((u(k)-u(k+1))**2+(v(k)-v(k+1))**2)*rdz*rdz
960 IF(the(k+1).GT.the(k))
THEN
961 IF(ps(k+1).GT.p(k))
THEN
963 wcon=(p(k+1)-ps(k+1))/(p(k+1)-p(k))
966 (q2(k).gt.epsq2(k)) .and. &
967 (q2(k)*cubry.gt.(dz*wcon*rsqdt)**2) &
970 dthv=(the(k)-the(k+1))+dthv
979 IF(abs(ghl)<=epsgh)ghl=epsgh
996 IF(gml/ghl<=requ)
THEN
1000 aubr=(aubm*gml+aubh*ghl)*ghl
1001 bubr= bubm*gml+bubh*ghl
1002 qol2st=(-0.5*bubr+sqrt(bubr*bubr*0.25-aubr*cubr))*rcubr
1003 eloq2x=1./max(epsgh, qol2st)
1004 elm(k)=max(sqrt(eloq2x*q2(k)),epsl(k))
1007 aden=(adnm*gml+adnh*ghl)*ghl
1008 bden= bdnm*gml+bdnh*ghl
1009 qol2un=-0.5*bden+sqrt(bden*bden*0.25-aden)
1010 eloq2x=1./(qol2un+epsru)
1011 elm(k)=max(sqrt(eloq2x*q2(k)),epsl(k))
1015 IF(elm(lmh-1)==epsl(lmh-1))lmxl=lmh
1021 blmx=z(lmxl)-z(lmh+1)
1033 qdzl=(q1(k)+q1(k+1))*(z(k+1)-z(k+2))
1034 szq=(z(k+1)+z(k+2)-z(lmh+1)-z(lmh+1))*qdzl+szq
1042 el0=min(alph*szq*0.5/sq,el0max)
1043 el0=max(el0 ,el0min)
1052 el(k)=min((z(k)-z(k+2))*elfc,elm(k))
1062 vkrmz=(z(k+1)-z(lmh+1))*vkarman
1063 el(k)=min(vkrmz/(vkrmz/el0+1.),elm(k))
1069 srel=min(((rel(k-1)+rel(k+1))*0.5+rel(k))*0.5,rel(k))
1070 el(k)=max(srel*elm(k),epsl(k))
1086 (ntsd,me,lmh,dtturbl,ustar,gm,gh,el,q2,epsl,epsq2,i,j,lm)
1092 INTEGER(KIND=KINT),
INTENT(IN):: &
1095 REAL(KIND=kfpt),
INTENT(IN):: &
1098 REAL(KIND=kfpt),
DIMENSION(1:LM-1),
INTENT(IN):: &
1101 real(kind=kfpt),
dimension(1:lm-1),
intent(in):: epsl
1102 real(kind=kfpt),
dimension(1:lm),
intent(in):: epsq2
1104 REAL(KIND=kfpt),
DIMENSION(1:LM-1),
INTENT(INOUT):: &
1107 REAL(KIND=kfpt),
DIMENSION(1:LM),
INTENT(INOUT):: &
1113 INTEGER(KIND=KINT):: &
1118 aden,aequ,anum,arhs,bden,bequ,bnum,brhs,cden,crhs &
1119 ,dloq1,eloq11,eloq12,eloq13,eloq21,eloq22,eloq31,eloq32 &
1120 ,eloq41,eloq42,eloq51,eloq52,eloqn,eqol2,ghl,gml &
1121 ,rden1,rden2,rhs2,rhsp1,rhsp2,rhst2
1130 main_integration:
DO k=1,lmh-1
1138 aequ=(aeqm*gml+aeqh*ghl)*ghl
1139 bequ= beqm*gml+beqh*ghl
1145 eqol2=-0.5*bequ+sqrt(bequ*bequ*0.25-aequ)
1151 IF(((gml+ghl*ghl<=epstrb) &
1152 & .OR.(ghl>=epsgh.AND.gml/ghl<=requ) &
1153 & .OR.(eqol2<=eps2)))
THEN
1177 anum=(anmm*gml+anmh*ghl)*ghl
1178 bnum= bnmm*gml+bnmh*ghl
1184 aden=(adnm*gml+adnh*ghl)*ghl
1185 bden= bdnm*gml+bdnh*ghl
1192 arhs=-(anum*bden-bnum*aden)*2.
1200 dloq1=el(k)/sqrt(q2(k))
1208 eloq31=eloq21*eloq11
1209 eloq41=eloq21*eloq21
1210 eloq51=eloq21*eloq31
1216 rden1=1./(aden*eloq41+bden*eloq21+cden)
1222 rhsp1=(arhs*eloq51+brhs*eloq31+crhs*eloq11)*rden1*rden1
1228 eloq12=eloq11+(dloq1-eloq11)*exp(rhsp1*dtturbl)
1229 eloq12=max(eloq12,eps1)
1235 eloq22=eloq12*eloq12
1236 eloq32=eloq22*eloq12
1237 eloq42=eloq22*eloq22
1238 eloq52=eloq22*eloq32
1244 rden2=1./(aden*eloq42+bden*eloq22+cden)
1245 rhs2 =-(anum*eloq42+bnum*eloq22)*rden2+rb1
1246 rhsp2= (arhs*eloq52+brhs*eloq32+crhs*eloq12)*rden2*rden2
1253 eloq13=eloq12-rhst2+(rhst2+dloq1-eloq12)*exp(rhsp2*dtturbl)
1254 eloq13=amax1(eloq13,eps1)
1263 q2(k)=el(k)*el(k)/(eloqn*eloqn)
1264 q2(k)=amax1(q2(k),epsq2(k))
1265 IF(q2(k)==epsq2(k))
THEN
1282 ENDDO main_integration
1288 q2(lmh)=amax1(b1**(2./3.)*ustar*ustar,epsq2(lmh))
1571 SUBROUTINE vdifh(DTDIF,LMH,THZ0,QZ0,RKHS,CHKLOWQ,CT &
1572 ,TH,Q,CWM,RKH,Z,RHO,I,J,LM)
1583 INTEGER(KIND=KINT),
INTENT(IN):: &
1586 REAL(KIND=kfpt),
INTENT(IN):: &
1587 chklowq,ct,dtdif,qz0,rkhs,thz0
1589 REAL(KIND=kfpt),
DIMENSION(1:LM-1),
INTENT(IN):: &
1592 REAL(KIND=kfpt),
DIMENSION(1:LM),
INTENT(IN):: &
1595 REAL(KIND=kfpt),
DIMENSION(1:LM+1),
INTENT(IN):: &
1598 REAL(KIND=kfpt),
DIMENSION(1:LM),
INTENT(INOUT):: &
1605 INTEGER(KIND=KINT):: &
1609 cf,cmb,cmcb,cmqb,cmtb,cthf,dtozl,dtozs &
1610 ,rcml,rkhh,rkqs,rscb,rsqb,rstb &
1613 REAL(KIND=kfpt),
DIMENSION(1:LM-1):: &
1614 cm,cr,dtoz,rkct,rsc,rsq,rst
1622 dtoz(k)=dtdif/(z(k)-z(k+1))
1623 cr(k)=-dtoz(k)*rkh(k)
1624 rkct(k)=rkh(k)*(z(k)-z(k+2))*cthf
1627 cm(1)=dtoz(1)*rkh(1)+rho(1)
1629 rst(1)=th(1)*rho(1)-rkct(1)*dtoz(1)
1631 rsc(1)=cwm(1)*rho(1)
1635 cf=-dtozl*rkh(k-1)/cm(k-1)
1636 cm(k)=-cr(k-1)*cf+(rkh(k-1)+rkh(k))*dtozl+rho(k)
1637 rst(k)=-rst(k-1)*cf+(rkct(k-1)-rkct(k))*dtozl+th(k)*rho(k)
1638 rsq(k)=-rsq(k-1)*cf+q(k) *rho(k)
1639 rsc(k)=-rsc(k-1)*cf+cwm(k)*rho(k)
1642 dtozs=dtdif/(z(lmh)-z(lmh+1))
1645 cf=-dtozs*rkhh/cm(lmh-1)
1649 cmtb=-cmb+(rkhh+rkhs)*dtozs+rho(lmh)
1650 cmqb=-cmb+(rkhh+rkqs)*dtozs+rho(lmh)
1651 cmcb=-cmb+(rkhh )*dtozs+rho(lmh)
1653 rstb=-rst(lmh-1)*cf+rkct(lmh-1)*dtozs+th(lmh)*rho(lmh)
1654 rsqb=-rsq(lmh-1)*cf+q(lmh) *rho(lmh)
1655 rscb=-rsc(lmh-1)*cf+cwm(lmh)*rho(lmh)
1658 th(lmh) =(dtozs*rkhs*thz0+rstb)/cmtb
1659 q(lmh) =(dtozs*rkqs*qz0 +rsqb)/cmqb
1660 cwm(lmh)=( rscb)/cmcb
1661 if(abs(tem1-th(lmh)).gt.8.)
then
1671 th(k) =(-cr(k)* th(k+1)+rst(k))*rcml
1672 q(k) =(-cr(k)* q(k+1)+rsq(k))*rcml
1673 cwm(k)=(-cr(k)*cwm(k+1)+rsc(k))*rcml