! save off q and t after cloud water!   do k=1,pver      qcwatn(:ncol,k) = state%q(:ncol,k,1)      tcwatn(:ncol,k) = state%t(:ncol,k)      lcwatn(:ncol,k) = state%q(:ncol,k,ixcldw)   end do!!     Convective transport of all trace species except water vapor and!     cloud water done here because we need to do the scavenging first!     to determine the interstitial fraction.!   ptend%name  = 'convtran2'   do m=2,ppcnst      if (m /= ixcldw) ptend%lq(m) = .true.   end do   call t_startf ('convtran2')   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 ('convtran2')   call physics_update (state, tend, ptend, ztodt)   call outfld('CMFDQR  ',cmfdqr, pcols,lchnk)   call outfld('CLDST   ',cldst,  pcols,lchnk)   call outfld('CNVCLD  ',clc,    pcols,lchnk)   call outfld('CONCLD  ',concld, pcols,lchnk)   call outfld('CME     ',qme,    pcols,lchnk)   call outfld('PRAIN   ',prain,  pcols,lchnk)   call outfld('EVAPR   ',nevapr, pcols,lchnk)   call outfld('DQP     ',qc,      pcols,   lchnk  )!! and add the precip of pcond and cond together. Note! since preclp is in kg/m2/s,  We need to renormalize to m/s! like other precips!   precl(:ncol) = precl(:ncol) + preclp(:ncol)/1000.!! Compute rate of temperature change due to moist processes!   dtcond(:ncol,:) = (state%s(:ncol,:) - dtcond(:ncol,:))*rtdt   call outfld('DTCOND  ',dtcond / cpair  ,pcols   ,lchnk   )!! Compute rate of constituent change due to moist processes!   dqcond(:ncol,:,:) = (state%q(:ncol,:,:) - dqcond(:ncol,:,:))*rtdt   do m=1,ppcnst      call outfld(dcconnam(m),dqcond(1,1,m),pcols   ,lchnk )   end do!!===================================================! Moist physical parameteriztions complete: ! send dynamical variables, and derived variables to history file!===================================================!   call diag_dynvar (lchnk, ncol, state)!!===================================================! Radiation computations!===================================================!! Cosine solar zenith angle for current time step!   call get_rlat_all_p(lchnk, ncol, clat)   call get_rlon_all_p(lchnk, ncol, clon)   call zenith (calday, clat, clon, coszrs, ncol)!! Compute liquid water paths!   tgcwp(:ncol) = 0.   do k=1,pver      do i = 1,ncol         gclwp2(i,k) = state%q(i,k,ixcldw)*state%pdel(i,k)/gravit*1000.0 ! Grid box liquid water path.         clwp2(i,k) = gclwp2(i,k) / max(0.01_r8,cldn(i,k))               ! In-cloud liquid water path.         tgcwp(i) = tgcwp(i) + gclwp2(i,k)      end do   end do   call outfld('GCLDLWP  ',gclwp2,  pcols,lchnk)   call outfld('ICLDLWP  ',clwp2,   pcols,lchnk)   call outfld('TGCLDCWP ',tgcwp,  pcols,lchnk)   if (dosw .or. dolw) then!! Compute cloud properties for input to radiation!      call t_startf('cldint')      call virtem (ncol, pcols, pver, state%t, state%q(1,1,1), zvir, tvm)      call cldint (lchnk, ncol, state%pmid, state%t, state%q(1,1,1), &                   state%pint, state%lnpint, state%lnpmid, tvm, state%zi,  &                   cldn, clwp, emis, effcld, landfrac,                    &                   rel, rei, fice, state%pdel, tpw,                  &                   hl, state%ps, nmxrgn, pmxrgn, clwp2)      call t_stopf('cldint')!! Dump cloud field information to history tape buffer (diagnostics)!      call outfld('CLOUD   ',cldn,  pcols,lchnk)      call outfld('EFFCLD  ',effcld, pcols,lchnk)      call outfld('LWSH    ',hl,     pcols,lchnk)!! Compute in cloud ice mixing ratio and in cloud liquid mixing ratio!      do k=1,pver         do i = 1,ncol            icimr(i,k) = state%q(i,k,ixcldw)*fice(i,k) / max(0.01_r8,cldn(i,k))            icwmr(i,k) = state%q(i,k,ixcldw)*(1.-fice(i,k)) / max(0.01_r8,cldn(i,k))         end do      end do      call outfld('ICIMR ',icimr,  pcols,lchnk)      call outfld('ICWMR ',icwmr,  pcols,lchnk)      call outfld('FICE  ',fice,   pcols,lchnk)!! Special diagnostic cloud water fields:!      call outfld('SETLWP  ',clwp,   pcols,lchnk)!! Output pure ice and pure liquid water paths!      tgiwp(:ncol) = 0.      do k=1,pver         tgiwp(:ncol) = tgiwp(:ncol) + gclwp2(:ncol,k)*fice(:ncol,k)      end do      tglwp(:ncol) = tgcwp(:ncol) - tgiwp(:ncol)      call outfld ('TGCLDLWP',tglwp,  pcols,lchnk)      call outfld ('TGCLDIWP',tgiwp,  pcols,lchnk)!! Complete radiation calculations!      call t_startf ('radctl')      call radctl (lchnk, ncol, lwup, emis, state%pmid,             &                   state%pint, state%lnpmid, state%lnpint, state%t, state%q,   &                   cldn, clwp2, coszrs, asdir, asdif,               &                   aldir, aldif, pmxrgn, nmxrgn, fsns, fsnt    ,flns    ,flnt    , &                   qrs, qrl, flwds, rel, rei,                       &                   fice, sols, soll, solsd, solld,                  &                   landfrac, state%zm)      call t_stopf ('radctl')!! Cloud cover diagnostics! radctl can change pmxrgn and nmxrgn so cldsav needs to follow ! radctl.!      call cldsav (lchnk, ncol, cldn, state%pmid, cltot, &                   cllow, clmed, clhgh, nmxrgn, pmxrgn)!! Dump cloud field information to history tape buffer (diagnostics)!      call outfld('CLDTOT  ',cltot  ,pcols,lchnk)      call outfld('CLDLOW  ',cllow  ,pcols,lchnk)      call outfld('CLDMED  ',clmed  ,pcols,lchnk)      call outfld('CLDHGH  ',clhgh  ,pcols,lchnk)   end if!! Compute net flux (for use in SLD energy fixer; not used in other dyn cores)! Since fsns, fsnt, flns, and flnt are in the buffer, array values will be carried across! timesteps when the radiation code is not invoked.!   do i=1,ncol      tend%flx_net(i) = fsnt(i) - fsns(i) - flnt(i) + flns(i)   end do!! Compute net radiative heating!   call radheat_net (state, ptend, qrl, qrs)!! Add radiation tendencies to cummulative model tendencies and update profiles!   call physics_update(state, tend, ptend, ztodt)!! Compute net surface radiative flux for use by surface temperature code.! Note that units have already been converted to mks in RADCTL.  Since! fsns and flwds are in the buffer, array values will be carried across! timesteps when the radiation code is not invoked.!   srfrad(:ncol) = fsns(:ncol) + flwds(:ncol)   call outfld('SRFRAD  ',srfrad,pcols,lchnk)!! determine whether precipitation, prec, is frozen (snow) or not! by taking the mass-weighted temperature of the bottom most layers.!!  determine mass weighted average temperature in the bottom three !  levels of the model (approximately the lowest 900 meters)!   dellow(:ncol) = 0.0   tavg (:ncol) = 0.0!   do k=pver-2, pver      dellow(:ncol) = dellow(:ncol) + state%pdel(:ncol,k)         tavg(:ncol) = tavg(:ncol) + state%t(:ncol,k )*state%pdel(:ncol,k)   end do!   tavg (:ncol) = tavg(:ncol)/dellow(:ncol)!   where (tavg(:ncol) > (tmelt-2.0) )      precsc(:ncol) = 0.      precsl(:ncol) = 0.   elsewhere      precsc(:ncol) = precc(:ncol)      precsl(:ncol) = precl(:ncol)   end where   prcsnw(:ncol) = precsc(:ncol) + precsl(:ncol)   ! total snowfall rate: needed by slab ocean model!! Save atmospheric fields to force surface models!   call srfxfer (lchnk, ncol, state%ps, state%u(1,pver), state%v(1,pver),    &                 state%t(1,pver), state%q(1,pver,1), state%exner(1,pver), state%zm(1,pver), &                    state%pmid,      &                 state%rpdel(1,pver))!---------------------------------------------------------------------------------------! Save history variables. These should move to the appropriate parameterization interface!---------------------------------------------------------------------------------------   call outfld('CMFMC   ',cmfmc   ,pcols   ,lchnk   )   call outfld('CMFSL   ',cmfsl   ,pcols   ,lchnk   )   call outfld('CMFLQ   ',cmflq   ,pcols   ,lchnk   )   call outfld('PRECL   ',precl   ,pcols   ,lchnk       )   call outfld('PRECC   ',precc   ,pcols   ,lchnk       )   call outfld('PRECSL  ',precsl  ,pcols   ,lchnk       )   call outfld('PRECSC  ',precsc  ,pcols   ,lchnk       )      prect(:ncol) = precc(:ncol) + precl(:ncol)   call outfld('PRECT   ',prect   ,pcols   ,lchnk       )   call outfld('PRECTMX ',prect   ,pcols   ,lchnk       )#if ( defined COUP_CSM )   call outfld('PRECLav ',precl   ,pcols   ,lchnk   )   call outfld('PRECCav ',precc   ,pcols   ,lchnk   )#endif!     ! Compute heating rate for dtheta/dt !   do k=1,pver      do i=1,ncol         ftem(i,k) = (qrs(i,k) + qrl(i,k))/cpair * (1.e5/state%pmid(i,k))**cappa      end do   end do   call outfld('HR      ',ftem    ,pcols   ,lchnk   )!! Convert mass fractions of non-water tracers back to mixing ratios.! (Overwrite non-water portions of q3m1).!   if (ppcnst > 1) then      call mf2mr (lchnk, ncol, state%q)   end if   returnend subroutine tphysbc