!   call qneg3('TPHYSBCb',lchnk  ,ncol    ,pcols   ,pver    , &              ppcnst,qmin  ,state%q )!! Setup q and t accumulation fields!   dqcond(:ncol,:,:) = state%q(:ncol,:,:)   dtcond(:ncol,:)   = state%s(:ncol,:)!! Zero out precip and convective fields before accumulating terms!   precl (:ncol)   = 0.   preclp(:ncol)   = 0.   precc (:ncol)   = 0.   precsl(:ncol)   = 0.   precsc(:ncol)   = 0.   qc    (:ncol,:) = 0.   cmfdqr(:ncol,:) = 0.   cmfmc (:ncol,:) = 0.   cmfsl (:ncol,:) = 0.   cmflq (:ncol,:) = 0.   dqcond(ncol+1:pcols,:,:) = 0.   dtcond(ncol+1:pcols,:)   = 0.   fracis (:ncol,:,1:ppcnst) = 1.!!===================================================! Dry adjustment!===================================================! Copy state info for input to dadadj! This is a kludge, so that dadadj does not have to be correctly reformulated in dry static energy   ptend%s(:ncol,:pver)   = state%t(:ncol,:pver)   ptend%q(:ncol,:pver,1) = state%q(:ncol,:pver,1)   call t_startf ('dadadj')   call dadadj (lchnk, ncol, state%pmid,  state%pint,  state%pdel,  &                ptend%s, ptend%q(1,1,1))   ptend%name  = 'dadadj'   ptend%ls    = .TRUE.   ptend%lq(1) = .TRUE.   ptend%s(:ncol,:)   = (ptend%s(:ncol,:)   - state%t(:ncol,:)  )/ztodt * cpair   ptend%q(:ncol,:,1) = (ptend%q(:ncol,:,1) - state%q(:ncol,:,1))/ztodt   call t_stopf ('dadadj')   call physics_update (state, tend, ptend, ztodt)!!===================================================! Moist convection!===================================================!! Since the PBL doesn't pass constituent perturbations, they! are zeroed here for input to the moist convection routine!   qpert(:ncol,2:ppcnst) = 0.0!! JR Set some arrays to zero @ nstep=0. Otherwise random junk off the heap! or stack will be used in zm_convr!   if (is_first_step()) then      pblht(:ncol)  = 0.      tpert(:ncol)  = 0.      cldo (:ncol,:)= 0.   end if!! Begin with Zhang-McFarlane (1996) convection parameterization!   call t_startf ('zm_convr')   call zm_convr( lchnk,    ncol, &                  state%t,   state%q,    precc,   cnt,     cnb,      &                  pblht,   state%zm, state%phis,    state%zi,   ptend%q(:,:,1),     &                  ptend%s, state%pmid,   state%pint,  state%pdel,  ts,       &                  .5*ztodt,cmfmc,    cmfcme,  nstep,             &                  tpert,   dlf,      pflx,    zdu,     cmfdqr,   &                  mu2,      md2,     du2,     eu2,     ed2,      &                  dp,       dsubcld, jt,      maxg,    ideep,    &                  lengath, icwmr1    )   ptend%name  = 'zm_convr'   ptend%ls    = .TRUE.   ptend%lq(1) = .TRUE.   ftem(:ncol,:pver) = ptend%s(:ncol,:pver)/cpair   call outfld('ZMDT    ',ftem           ,pcols   ,lchnk   )   call outfld('ZMDQ    ',ptend%q(1,1,1) ,pcols   ,lchnk   )   call t_stopf('zm_convr')   call physics_update(state, tend, ptend, ztodt)!! Evaporate some of the precip directly into the environment (Sundqvist)!   call zm_conv_evap(state, ptend, pflx, precc, cldo, ztodt, evappct)   ptend%name  = 'zm_conv_evap'   ptend%ls    = .TRUE.   ptend%lq(1) = .TRUE.   call outfld('EVAPPCT ',evappct,pcols,state%lchnk)   call physics_update(state, tend, ptend, ztodt)!! Transport cloud water only!   ptend%name = 'convtran1'   do m=2,ppcnst      if (m == ixcldw) ptend%lq(m) = .true.   end do   call t_startf ('convtran1')   call convtran (lchnk,                                        &                  ptend%lq,state%q, ppcnst,  mu2,     md2,   &                  du2,     eu2,     ed2,     dp,      dsubcld,  &                  jt,      maxg,    ideep,   1,       lengath,  &                  nstep,   fracis,  ptend%q   )   call t_stopf ('convtran1')   call physics_update (state, tend, ptend, ztodt)!! Convert mass flux from reported mb/s to kg/m^2/s!   cmfmc(:ncol,:pver) = cmfmc(:ncol,:pver) * 100./gravit!! Add production of rain by zm_convr to qc.  Added 1 to k-index of pflx! at instruction of PJR!   do k=2,pver      do i=1,ncol         qc(i,k) = qc(i,k) + (pflx(i,k+1) - pflx(i,k))*gravit/state%pdel(i,k)      end do   end do!! Call Hack (1994) convection scheme to deal with shallow/mid-level convection! Begin by zeroing local copies of mass flux, energy fluxes, etc.!   cmfmc2 (:ncol,:pver) = 0.   cmfdqr2(:ncol,:pver) = 0.   cmfsl2 (:ncol,:pver) = 0.   cmflq2 (:ncol,:pver) = 0.   qc2    (:ncol,:pver) = 0.!! At PJR's instruction, deleted kludge to get past a once in a lifetime! problem in cmfmca's transport of liq water due to reliance on m=2 being! hard-wired to cloud water--JR.  Put back in after run bombed.!   where (abs(state%q(:ncol,:pver,ixcldw)) < 1.e-36)      state%q(:ncol,:pver,ixcldw) = 0.   end where   call t_startf('cmfmca')   tpert2(:ncol  ) =0.   qpert2(:ncol,:) = qpert(:ncol,:)  ! BAB Why is this not zero, if tpert2=0???   call cmfmca (lchnk,   ncol, &                nstep,   ztodt,   state%pmid,  state%pdel,   &                state%rpdel,   state%zm,      tpert2,  qpert2,  state%phis,     &                pblht,   state%t,   state%q,   ptend%s,   ptend%q,      &                cmfmc2,  cmfdqr2, cmfsl2,  cmflq2,  precc2,   &                qc2,     cnt2,    cnb2,    icwmr2   )   ptend%name  = 'cmfmca'   ptend%ls    = .TRUE.   ptend%lq(:) = .TRUE.   ftem(:ncol,:pver) = ptend%s(:ncol,:pver)/cpair   call outfld('CMFDT   ',ftem          ,pcols   ,lchnk   )   call outfld('CMFDQ   ',ptend%q(1,1,1),pcols   ,lchnk   )   call t_stopf('cmfmca')   call physics_update (state, tend, ptend, ztodt)!! Merge shallow/mid-level output with prior results from Zhang-McFarlane!   do i=1,ncol      precc(i) = precc(i) + precc2(i)      if (cnt2(i) < cnt(i)) cnt(i) = cnt2(i)      if (cnb2(i) > cnb(i)) cnb(i) = cnb2(i)   end do!   cmfmc(:ncol,:pver)  = cmfmc(:ncol,:pver)  + cmfmc2(:ncol,:pver)   cmfdqr(:ncol,:pver) = cmfdqr(:ncol,:pver) + cmfdqr2(:ncol,:pver)   cmfsl(:ncol,:pver)  = cmfsl(:ncol,:pver)  + cmfsl2(:ncol,:pver)   cmflq(:ncol,:pver)  = cmflq(:ncol,:pver)  + cmflq2(:ncol,:pver)   qc(:ncol,:pver)     = qc(:ncol,:pver)     + qc2(:ncol,:pver)#ifndef PCWDETRAIN!! put the detraining cloud water into precip to conserve! mass!   do k = 1,pver      do i = 1,ncol         precc(i) = precc(i) + dlf(i,k)*state%pdel(i,k)/(gravit*1000.)      end do   end do#else!! put the detraining cloud water into the cloud and environment in! proportion to the cloud fraction!   do k = 1,pver      do i = 1,ncol         ptend%q(i,k,1)      = dlf(i,k)*(1.-cldo(i,k))         ptend%s(i,k)        =-dlf(i,k)*(1.-cldo(i,k))*latvap         ptend%q(i,k,ixcldw) = dlf(i,k)*cldo(i,k)      end do   end do   ptend%name  = 'pcwdetrain'   ptend%ls    = .TRUE.   ptend%lq(1) = .TRUE.   ptend%lq(ixcldw) = .TRUE.   call physics_update(state, tend, ptend, ztodt)#endif!! cloud fraction after transport and convection,! derive the relationship between rh and cld from ! the employed cloud scheme!   call t_startf('cldnrh')   call cldnrh(lchnk,   ncol,                                &               state%pmid,    state%t,   state%q(1,1,1),   state%omega, &               cnt,     cnb,     cldn,    clc,     state%pdel,   &               cmfmc,   landfrac,snowh,   concld,  cldst,    &               ts,      state%pint(1,pverp),       zdu,  ocnfrac, &               rhdfda,   rhu00 )   call t_stopf('cldnrh')!! calculate the tendencies for moisture, temperature and cloud fraction!   rtdt = 1./ztodt   qtend(:ncol,:pver) = (state%q(:ncol,:pver,1)       - qcwato(:ncol,:pver))*rtdt   ttend(:ncol,:pver) = (state%t(:ncol,:pver)         - tcwato(:ncol,:pver))*rtdt   lctend(:ncol,:pver) = (state%q(:ncol,:pver,ixcldw) - lcwato(:ncol,:pver))*rtdt!! strat condensation via prognostic cloud water! calculate tendencies!   call t_startf('pcond')   zero(:ncol,:pverp) = 0.   call pcond (lchnk,   ncol, &               state%t,   ttend,   state%q(1,1,1), qtend,       state%omega,     &               state%q(1,1,ixcldw),state%pmid,     state%pdel,  cldn,     &               qme,     nevapr,    prain,          rmelt,    &               ztodt,   zero,      fwaut,          fsaut,       fracw,    &               fsacw,   fsaci,     lctend,         rhdfda,      rhu00, icefrac)   call t_stopf('pcond')!   call outfld('FWAUT',fwaut, pcols,lchnk)   call outfld('FSAUT',fsaut, pcols,lchnk)   call outfld('FRACW',fracw, pcols,lchnk)   call outfld('FSACW',fsacw, pcols,lchnk)   call outfld('FSACI',fsaci, pcols,lchnk)!! make it interactive!   do k = 1,pver      do i = 1,ncol         ptend%s(i,k)        = (qme(i,k) - nevapr(i,k))*latvap + rmelt(i,k)         ptend%q(i,k,1)      =-(qme(i,k) - nevapr(i,k))         ptend%q(i,k,ixcldw) = (qme(i,k) - prain(i,k))         preclp(i) = preclp(i) + (prain(i,k)-nevapr(i,k))*state%pdel(i,k)/gravit      end do   end do   ptend%name  = 'pcond'   ptend%ls    = .TRUE.   ptend%lq(1) = .TRUE.   ptend%lq(ixcldw) = .TRUE.   call physics_update (state, tend, ptend, ztodt)!