subroutine gscond_ad( im, ix, km, dt, sl, ps, rhc, advt, advq, & advp, q_in, cwm_in, t_in, q_out, cwm_out, t_out, advt_ad, advq_ad, & advp_ad, q_in_ad, cwm_in_ad, t_in_ad, q_out_ad, cwm_out_ad, t_out_ad, & adjoint ) !$$$ subprogram documentation block ! . . . . ! subprogram: gscond_ad forward & adjoint model for GFS gridscale condensation ! prgmmr: treadon org: np23 date: 2003-12-18 ! ! abstract: This subroutine contains the forward and ajoint models for the ! GFS gridscale condensation algorithm ! ! program history log: ! 2003-12-18 treadon - initial routine ! 2004-06-14 treadon - reformat documenation ! 2006-04-12 treadon - change sl from 1d to 2d array ! 2008-06-02 safford - rm unused var ! ! input argument list: ! im - actual number of profiles to be processed ! ix - maximum number of profiles to process (array dimension) ! km - number of levels in vertical profile ! dt - physics timestep ! sl - "sigma" value at layer midpoints ! ps - surface pressure ! rhc - critcal relative humidity thresholds ! advt - temperature advection ! advq - moisture advection ! advp - pressure advection ! q_in - specific humidity ! cwm_in - cloud condensate mixing ratio ! t_in - temperature ! advt_ad - temperature advection perturbation ! advq_ad - moisture advection perturbation ! advp_ad - pressure advection perturbation ! q_out_ad - moisture perturbation ! cwm_out_ad- cloud condesate mixing ratio perturbation ! t_out_ad - temperature perturbation ! adjoint - logical flag (.false.=forward model only, .true.=forward and ajoint) ! ! output argument list: ! q_out - moisture following gridscale condensation ! cwm_out - cloud condensation mixing ratio following gridscale condensation ! t_out - temperature following gridscale condensation ! q_in_adt - change in condensation with respect to moisture ! cwm_in_ad - change in condensation with respect to cloud condensation mixing ratio ! t_in_ad - change in condensation with respect to temperature ! ! remarks: ! The adjoint portion of this routine was generated by the ! Tangent linear and Adjoint Model Compiler, TAMC 5.3.0 ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ !============================================== ! all entries are defined explicitly !============================================== use kinds, only: r_kind,i_kind use constants, only: izero, ione, zero, half, one, two, el2orc, cclimit, elocp, rcp, & cp, cpr, h1000, eps, climit, epsq, epsm1, hsub, hvap, ttp implicit none !============================================== ! define arguments !============================================== logical ,intent(in ) :: adjoint integer(i_kind),intent(in ) :: im integer(i_kind),intent(in ) :: km real(r_kind) ,intent(inout) :: advp_ad(km,im) real(r_kind) ,intent(inout) :: advq_ad(km,im) real(r_kind) ,intent(inout) :: advt_ad(km,im) integer(i_kind),intent(in ) :: ix real(r_kind) ,intent( out) :: cwm_in_ad(km,ix) real(r_kind) ,intent(inout) :: cwm_out_ad(km,ix) real(r_kind) ,intent( out) :: q_in_ad(km,ix) real(r_kind) ,intent(inout) :: q_out_ad(km,ix) real(r_kind) ,intent( out) :: t_in_ad(km,ix) real(r_kind) ,intent(inout) :: t_out_ad(km,ix) real(r_kind) ,intent(in ) :: advp(km,im) real(r_kind) ,intent(in ) :: advq(km,im) real(r_kind) ,intent(in ) :: advt(km,im) real(r_kind) ,intent(in ) :: cwm_in(km,ix) real(r_kind) ,intent( out) :: cwm_out(km,ix) real(r_kind) ,intent(in ) :: dt real(r_kind) ,intent(in ) :: ps(im) real(r_kind) ,intent(in ) :: q_in(km,ix) real(r_kind) ,intent( out) :: q_out(km,ix) real(r_kind) ,intent(in ) :: rhc(km,ix) real(r_kind) ,intent(in ) :: sl(km,ix) real(r_kind) ,intent(in ) :: t_in(km,ix) real(r_kind) ,intent( out) :: t_out(km,ix) !============================================== ! define local variables !============================================== real(r_kind) aa real(r_kind) ab real(r_kind) ac real(r_kind) ad real(r_kind) aa_ad real(r_kind) ab_ad real(r_kind) ac_ad real(r_kind) ad_ad real(r_kind) ae_ad real(r_kind) af_ad real(r_kind) ag_ad real(r_kind) ai_ad real(r_kind) ap_ad real(r_kind) aq_ad real(r_kind) at_ad real(r_kind) ccrik_ad real(r_kind) ccrik1_ad real(r_kind) cond_ad real(r_kind) cond1_ad real(r_kind) cond2_ad real(r_kind) cond3_ad real(r_kind) condi_ad real(r_kind) cone0_ad real(r_kind) cwmik_ad real(r_kind) cwmin_ad real(r_kind) delq_1_ad real(r_kind) delq_2_ad real(r_kind) delq_3_ad real(r_kind) e0_ad real(r_kind) e1_ad real(r_kind) e2_ad real(r_kind) e3_ad real(r_kind) e4_ad real(r_kind) es_1_ad real(r_kind) es_2_ad real(r_kind) es_3_ad real(r_kind) esk_ad real(r_kind) qik_ad real(r_kind) qin_ad real(r_kind) qs_1_ad real(r_kind) qs_2_ad real(r_kind) qs_3_ad real(r_kind) qsik_ad real(r_kind) qsk_ad real(r_kind) rqik_ad real(r_kind) rqikk_ad real(r_kind) tik_ad real(r_kind) tmt0_ad real(r_kind) tsq_1_ad real(r_kind) tsq_2_ad real(r_kind) tsq_3_ad real(r_kind) tx1_1_ad real(r_kind) tx1_2_ad real(r_kind) tx1_3_ad real(r_kind) tx2_2_ad real(r_kind) tx2_3_ad real(r_kind) tx2_4_ad real(r_kind) tx3_1_ad real(r_kind) tx3_2_ad real(r_kind) tx3_3_ad real(r_kind) ae real(r_kind) af real(r_kind) ag real(r_kind) ai real(r_kind) ap real(r_kind) aq real(r_kind) at real(r_kind) ccrik real(r_kind) ccrik1 real(r_kind) cond real(r_kind) cond1 real(r_kind) cond2 real(r_kind) cond3 real(r_kind) condi real(r_kind) cone0 real(r_kind) cwmik real(r_kind) cwmin real(r_kind) delq_1 real(r_kind) delq_2 real(r_kind) delq_3 real(r_kind) dum1 real(r_kind) dum2 real(r_kind) e0 real(r_kind) e1 real(r_kind) e2 real(r_kind) e3 real(r_kind) e4 real(r_kind) elv,elvk(km,ix) real(r_kind) es_1,es_1k(km,ix) real(r_kind) es_2,es_2k(km,ix) real(r_kind) es_3,es_3k(km,ix) real(r_kind) esk,eski(km,ix) integer(i_kind) i integer(i_kind) iw0,iw0k(km,ix) integer(i_kind) iw1,iw1k(km,ix) integer(i_kind) k real(r_kind) pres real(r_kind) prsk real(r_kind) qik real(r_kind) qin real(r_kind) qs_1 real(r_kind) qs_2 real(r_kind) qs_3 real(r_kind) qsik real(r_kind) qsk,qski(km,ix) real(r_kind) rdt real(r_kind) rqik real(r_kind) rqikk real(r_kind) tik real(r_kind) tmt0 real(r_kind) tsq_1 real(r_kind) tsq_2 real(r_kind) tsq_3 real(r_kind) tx1_1 real(r_kind) tx1_2 real(r_kind) tx1_3 real(r_kind) tx2_2 real(r_kind) tx2_3 real(r_kind) tx2_4 real(r_kind) tx3_1 real(r_kind) tx3_2 real(r_kind) tx3_3 real(r_kind) u00ik real(r_kind) us00 !---------------------------------------------- ! RESET LOCAL ADJOINT VARIABLES !---------------------------------------------- aa_ad = zero ab_ad = zero ac_ad = zero ad_ad = zero ae_ad = zero af_ad = zero ag_ad = zero ai_ad = zero ap_ad = zero aq_ad = zero at_ad = zero ccrik_ad = zero ccrik1_ad = zero cond_ad = zero cond1_ad = zero cond2_ad = zero cond3_ad = zero condi_ad = zero cone0_ad = zero cwmik_ad = zero cwmin_ad = zero delq_1_ad = zero delq_2_ad = zero delq_3_ad = zero e0_ad = zero e1_ad = zero e2_ad = zero e3_ad = zero e4_ad = zero es_1_ad = zero es_2_ad = zero es_3_ad = zero esk_ad = zero qik_ad = zero qin_ad = zero qs_1_ad = zero qs_2_ad = zero qs_3_ad = zero qsik_ad = zero qsk_ad = zero rqik_ad = zero rqikk_ad = zero tik_ad = zero tmt0_ad = zero tsq_1_ad = zero tsq_2_ad = zero tsq_3_ad = zero tx1_1_ad = zero tx1_2_ad = zero tx1_3_ad = zero tx2_2_ad = zero tx2_3_ad = zero tx2_4_ad = zero tx3_1_ad = zero tx3_2_ad = zero tx3_3_ad = zero !---------------------------------------------- ! ROUTINE BODY !---------------------------------------------- !---------------------------------------------- ! FUNCTION AND TAPE COMPUTATIONS !---------------------------------------------- rdt = one/dt do i = 1, im iw0 = izero iw1 = iw0 iw0k(km,i) = iw0 iw1k(km,i) = iw0 do k = km, 1, -1 cwmin = cwm_in(k,i) tik = t_in(k,i) qin = q_in(k,i) if (qin > epsq) then qik = qin else qik = epsq endif if (cwmin > climit) then cwmik = cwmin else cwmik = climit endif prsk = ps(i)*sl(k,i) call fpvsx_ad(tik,esk,dum1,dum2,.false.) qsk = eps*esk/(prsk+epsm1*esk) if (qsk > epsq) then qsik = qsk else qsik = epsq endif ! Save forward model calculation for use in adjoint model eski(k,i) = esk qski(k,i) = qsk ! tmt0 = tik-ttp if (tmt0 < (-15._r_kind)) then u00ik = rhc(k,i) if (qik-u00ik*qsik > zero .or. cwmik > climit) then iw0 = ione else iw0 = izero endif endif if (tmt0 >= zero) then iw0 = izero endif if (tmt0 < zero .and. tmt0 >= (-15._r_kind)) then iw0 = izero if (k < km) then if (iw1 == ione .and. cwmik > climit) then iw0 = ione endif endif endif if (iw0 == izero) then elv = hvap else elv = hsub endif iw1 = iw0 ! Save forward model values for adjoint model iw0k(k,i) = iw0 iw1k(k,i) = iw1 elvk(k,i) = elv u00ik = rhc(k,i) pres = prsk*h1000 at = advt(k,i) aq = advq(k,i) ap = advp(k,i) if (qsik <= 1.e-10_r_kind) then rqik = zero else rqik = qik/qsik endif if (rqik < u00ik) then ccrik = zero else if (rqik >= one) then ccrik = one else if (rqik < one) then rqikk = rqik else rqikk = one endif ccrik = one-sqrt((one-rqikk)/(one-u00ik)) endif if (ccrik <= cclimit .and. cwmik > climit) then tx1_1 = tik tx3_1 = qik call fpvsx_ad(tx1_1,es_1,dum1,dum2,.false.) es_1k(k,i) = es_1 qs_1 = u00ik*eps*es_1/(prsk+epsm1*es_1) tsq_1 = tx1_1*tx1_1 delq_1 = half*(qs_1-tx3_1)*tsq_1/(tsq_1+el2orc*qs_1) tx2_2 = delq_1 tx1_2 = tx1_1-delq_1*elocp tx3_2 = tx3_1+delq_1 call fpvsx_ad(tx1_2,es_2,dum1,dum2,.false.) es_2k(k,i) = es_2 qs_2 = u00ik*eps*es_2/(prsk+epsm1*es_2) tsq_2 = tx1_2*tx1_2 delq_2 = (qs_2-tx3_2)*tsq_2/(tsq_2+el2orc*qs_2) tx2_3 = tx2_2+delq_2 tx1_3 = tx1_2-delq_2*elocp tx3_3 = tx3_2+delq_2 call fpvsx_ad(tx1_3,es_3,dum1,dum2,.false.) es_3k(k,i) = es_3 qs_3 = u00ik*eps*es_3/(prsk+epsm1*es_3) tsq_3 = tx1_3*tx1_3 delq_3 = (qs_3-tx3_3)*tsq_3/(tsq_3+el2orc*qs_3) tx2_4 = tx2_3+delq_3 e4 = tx2_4*rdt if (e4 < zero) then e3 = zero else e3 = e4 endif if (cwmik*rdt < e3) then e2 = cwmik*rdt else e2 = e3 endif if (e2 < zero) then e1 = zero else e1 = e2 endif e0 = e1 else e0 = zero endif if (ccrik > cclimit .and. qsik > epsq) then us00 = one-u00ik ccrik1 = one-ccrik aa = eps*elv*pres*qik ab = ccrik*ccrik1*qsik*us00 ac = ab+half*cwmik ad = ab*ccrik1 ae = cpr*tik*tik af = ae*pres ag = aa*elv ai = cp*aa cond1 = (ac-ad)*(af*aq-ai*at+ae*qik*ap)/(ac*(af+ag)) condi = (qik-u00ik*qsik*one)*rdt if (cond1 < condi) then cond2 = cond1 else cond2 = condi endif if (cond2 > zero) then cond3 = cond2 else cond3 = zero endif cond = cond3 else cond = zero endif cone0 = (cond-e0)*dt cwm_out(k,i) = cwmin+cone0 t_out(k,i) = tik+elv*rcp*cone0 q_out(k,i) = qin-cone0 end do end do if (.not.adjoint) return !---------------------------------------------- ! ADJOINT COMPUTATIONS !---------------------------------------------- do i = im, 1, -1 do k = 1, km iw0 = 0 iw1 = iw0 ! Load values saved from forward model. iw0 = iw0k(k,i) iw1 = iw1k(k,i) elv = elvk(k,i) esk = eski(k,i) qsk = qski(k,i) ! ! Redo some forward model calculations cwmin = cwm_in(k,i) tik = t_in(k,i) qin = q_in(k,i) if (qin > epsq) then qik = qin else qik = epsq endif if (cwmin > climit) then cwmik = cwmin else cwmik = climit endif prsk = ps(i)*sl(k,i) if (qsk > epsq) then qsik = qsk else qsik = epsq endif u00ik = rhc(k,i) pres = prsk*h1000 at = advt(k,i) aq = advq(k,i) ap = advp(k,i) if (qsik <= 1.e-10_r_kind) then rqik = zero else rqik = qik/qsik endif if (rqik < u00ik) then ccrik = zero else if (rqik >= one) then ccrik = one else if (rqik < one) then rqikk = rqik else rqikk = one endif ccrik = one-sqrt((one-rqikk)/(one-u00ik)) endif ! Adjoint model cone0_ad = cone0_ad-q_out_ad (k,i) qin_ad = qin_ad +q_out_ad (k,i) q_out_ad(k,i) = zero cone0_ad = cone0_ad+t_out_ad (k,i)*elv*rcp tik_ad = tik_ad +t_out_ad (k,i) t_out_ad(k,i) = zero cone0_ad = cone0_ad+cwm_out_ad(k,i) cwmin_ad = cwmin_ad+cwm_out_ad(k,i) cwm_out_ad(k,i) = zero cond_ad = cond_ad +cone0_ad*dt e0_ad = e0_ad -cone0_ad*dt cone0_ad = zero if (ccrik > cclimit .and. qsik > epsq) then ! Redo forward model calculations us00 = one-u00ik ccrik1 = one-ccrik aa = eps*elv*pres*qik ab = ccrik*ccrik1*qsik*us00 ac = ab+half*cwmik ad = ab*ccrik1 ae = cpr*tik*tik af = ae*pres ag = aa*elv ai = cp*aa cond1 = (ac-ad)*(af*aq-ai*at+ae*qik*ap)/(ac*(af+ag)) condi = (qik-u00ik*qsik*one)*rdt if (cond1 < condi) then cond2 = cond1 else cond2 = condi endif ! Adjoint model cond3_ad = cond3_ad+cond_ad cond_ad = zero if (cond2 > zero) then cond2_ad = cond2_ad+cond3_ad cond3_ad = zero else cond3_ad = zero endif if (cond1 < condi) then cond1_ad = cond1_ad+cond2_ad cond2_ad = zero else condi_ad = condi_ad+cond2_ad cond2_ad = zero endif qik_ad = qik_ad + condi_ad *rdt qsik_ad = qsik_ad-one*condi_ad*u00ik*rdt condi_ad = zero ac_ad = ac_ad+cond1_ad*((af*aq-ai*at+ae*qik*ap)/(ac*(af+ag))- & (ac-ad)*(af*aq-ai*at+ae*qik*ap)*(af+ag)/(ac*(af+ag)*ac*(af+ag))) ad_ad = ad_ad-cond1_ad*((af*aq-ai*at+ae*qik*ap)/(ac*(af+ag))) ae_ad = ae_ad+cond1_ad*((ac-ad)*qik*ap/(ac*(af+ag))) af_ad = af_ad+cond1_ad*((ac-ad)*aq/(ac*(af+ag))-(ac-ad)*(af*aq- & ai*at+ae*qik*ap)*ac/(ac*(af+ag)*ac*(af+ag))) ag_ad = ag_ad-cond1_ad*((ac-ad)*(af*aq-ai*at+ae*qik*ap)*ac/(ac* & (af+ag)*ac*(af+ag))) ai_ad = ai_ad-cond1_ad*((ac-ad)*at/(ac*(af+ag))) ap_ad = ap_ad+cond1_ad*((ac-ad)*ae*qik/(ac*(af+ag))) aq_ad = aq_ad+cond1_ad*((ac-ad)*af/(ac*(af+ag))) at_ad = at_ad-cond1_ad*((ac-ad)*ai/(ac*(af+ag))) qik_ad = qik_ad+cond1_ad*((ac-ad)*ae*ap/(ac*(af+ag))) cond1_ad = zero aa_ad = aa_ad+ai_ad*cp ai_ad = zero aa_ad = aa_ad+ag_ad*elv ag_ad = zero ae_ad = ae_ad+af_ad*pres af_ad = zero tik_ad = tik_ad+2*ae_ad*cpr*tik ae_ad = zero ab_ad = ab_ad+ad_ad*ccrik1 ccrik1_ad = ccrik1_ad+ad_ad*ab ad_ad = zero ab_ad = ab_ad+ac_ad cwmik_ad = cwmik_ad+half*ac_ad ac_ad = zero ccrik_ad = ccrik_ad+ab_ad*ccrik1*qsik*us00 ccrik1_ad = ccrik1_ad+ab_ad*ccrik*qsik*us00 qsik_ad = qsik_ad+ab_ad*ccrik*ccrik1*us00 ab_ad = zero qik_ad = qik_ad+aa_ad*eps*elv*pres aa_ad = zero ccrik_ad = ccrik_ad-ccrik1_ad ccrik1_ad = zero else cond_ad = zero endif if (ccrik <= cclimit .and. cwmik > climit) then ! Redo forward model calculations. Vapor pressure calculations ! are saved from the forward model tx1_1 = tik tx3_1 = qik es_1 = es_1k(k,i) qs_1 = u00ik*eps*es_1/(prsk+epsm1*es_1) tsq_1 = tx1_1*tx1_1 delq_1 = half*(qs_1-tx3_1)*tsq_1/(tsq_1+el2orc*qs_1) tx2_2 = delq_1 tx1_2 = tx1_1-delq_1*elocp tx3_2 = tx3_1+delq_1 es_2 = es_2k(k,i) qs_2 = u00ik*eps*es_2/(prsk+epsm1*es_2) tsq_2 = tx1_2*tx1_2 delq_2 = (qs_2-tx3_2)*tsq_2/(tsq_2+el2orc*qs_2) tx2_3 = tx2_2+delq_2 tx1_3 = tx1_2-delq_2*elocp tx3_3 = tx3_2+delq_2 es_3 = es_3k(k,i) qs_3 = u00ik*eps*es_3/(prsk+epsm1*es_3) tsq_3 = tx1_3*tx1_3 delq_3 = (qs_3-tx3_3)*tsq_3/(tsq_3+el2orc*qs_3) tx2_4 = tx2_3+delq_3 e4 = tx2_4*rdt if (e4 < zero) then e3 = zero else e3 = e4 endif if (cwmik*rdt < e3) then e2 = cwmik*rdt else e2 = e3 endif ! Adjoint model e1_ad = e1_ad+e0_ad e0_ad = zero if (e2 < zero) then e1_ad = zero else e2_ad = e2_ad+e1_ad e1_ad = zero endif if (cwmik*rdt < e3) then cwmik_ad = cwmik_ad+e2_ad*rdt e2_ad = zero else e3_ad = e3_ad+e2_ad e2_ad = zero endif if (e4 < zero) then e3_ad = zero else e4_ad = e4_ad+e3_ad e3_ad = zero endif tx2_4_ad = tx2_4_ad+e4_ad*rdt e4_ad = zero delq_3_ad = delq_3_ad+tx2_4_ad tx2_3_ad = tx2_3_ad+tx2_4_ad tx2_4_ad = zero qs_3_ad = qs_3_ad+delq_3_ad*(tsq_3/(tsq_3+el2orc*qs_3)-(qs_3- & tx3_3)*tsq_3*el2orc/((tsq_3+el2orc*qs_3)*(tsq_3+el2orc*qs_3))) tsq_3_ad = tsq_3_ad+delq_3_ad*((qs_3-tx3_3)/(tsq_3+el2orc*qs_3) & -(qs_3-tx3_3)*tsq_3/((tsq_3+el2orc*qs_3)*(tsq_3+el2orc*qs_3))) tx3_3_ad = tx3_3_ad-delq_3_ad*(tsq_3/(tsq_3+el2orc*qs_3)) delq_3_ad = zero tx1_3_ad = tx1_3_ad+2*tsq_3_ad*tx1_3 tsq_3_ad = zero es_3_ad = es_3_ad+qs_3_ad*(u00ik*eps/(prsk+epsm1*es_3)-u00ik* & eps*es_3*epsm1/((prsk+epsm1*es_3)*(prsk+epsm1*es_3))) qs_3_ad = zero call fpvsx_ad( tx1_3,es_3,tx1_3_ad,es_3_ad,adjoint ) es_3_ad = zero delq_2_ad = delq_2_ad+tx3_3_ad tx3_2_ad = tx3_2_ad+tx3_3_ad tx3_3_ad = zero delq_2_ad = delq_2_ad-tx1_3_ad*elocp tx1_2_ad = tx1_2_ad+tx1_3_ad tx1_3_ad = zero delq_2_ad = delq_2_ad+tx2_3_ad tx2_2_ad = tx2_2_ad+tx2_3_ad tx2_3_ad = zero qs_2_ad = qs_2_ad+delq_2_ad*(tsq_2/(tsq_2+el2orc*qs_2)-(qs_2- & tx3_2)*tsq_2*el2orc/((tsq_2+el2orc*qs_2)*(tsq_2+el2orc*qs_2))) tsq_2_ad = tsq_2_ad+delq_2_ad*((qs_2-tx3_2)/(tsq_2+el2orc*qs_2) & -(qs_2-tx3_2)*tsq_2/((tsq_2+el2orc*qs_2)*(tsq_2+el2orc*qs_2))) tx3_2_ad = tx3_2_ad-delq_2_ad*(tsq_2/(tsq_2+el2orc*qs_2)) delq_2_ad = zero tx1_2_ad = tx1_2_ad+2*tsq_2_ad*tx1_2 tsq_2_ad = zero es_2_ad = es_2_ad+qs_2_ad*(u00ik*eps/(prsk+epsm1*es_2)-u00ik* & eps*es_2*epsm1/((prsk+epsm1*es_2)*(prsk+epsm1*es_2))) qs_2_ad = zero call fpvsx_ad( tx1_2,es_2,tx1_2_ad,es_2_ad,adjoint ) es_2_ad = zero delq_1_ad = delq_1_ad+tx3_2_ad tx3_1_ad = tx3_1_ad+tx3_2_ad tx3_2_ad = zero delq_1_ad = delq_1_ad-tx1_2_ad*elocp tx1_1_ad = tx1_1_ad+tx1_2_ad tx1_2_ad = zero delq_1_ad = delq_1_ad+tx2_2_ad tx2_2_ad = zero qs_1_ad = qs_1_ad+delq_1_ad*(half*tsq_1/(tsq_1+el2orc*qs_1)-half* & (qs_1-tx3_1)*tsq_1*el2orc/((tsq_1+el2orc*qs_1)* & (tsq_1+el2orc*qs_1) )) tsq_1_ad = tsq_1_ad+delq_1_ad*(half*(qs_1-tx3_1)/(tsq_1+el2orc* & qs_1)-half*(qs_1-tx3_1)*tsq_1/((tsq_1+el2orc*qs_1)* & (tsq_1+el2orc*qs_1))) tx3_1_ad = tx3_1_ad+delq_1_ad*((-half)*tsq_1/(tsq_1+el2orc*qs_1)) delq_1_ad = zero tx1_1_ad = tx1_1_ad+2*tsq_1_ad*tx1_1 tsq_1_ad = zero es_1_ad = es_1_ad+qs_1_ad*(u00ik*eps/(prsk+epsm1*es_1)-u00ik* & eps*es_1*epsm1/((prsk+epsm1*es_1)*(prsk+epsm1*es_1))) qs_1_ad = zero call fpvsx_ad( tx1_1,es_1,tx1_1_ad,es_1_ad,adjoint ) es_1_ad = zero qik_ad = qik_ad+tx3_1_ad tx3_1_ad = zero tik_ad = tik_ad+tx1_1_ad tx1_1_ad = zero else e0_ad = zero endif if (rqik < u00ik) then ccrik_ad = zero else if (rqik >= one) then ccrik_ad = zero else rqikk_ad = rqikk_ad+ccrik_ad*(one/(two*sqrt((one-rqikk)/ & (one-u00ik)))/(one-u00ik)) ccrik_ad = zero if (rqik < one) then rqik_ad = rqik_ad+rqikk_ad rqikk_ad = zero else rqikk_ad = zero endif endif if (qsik <= 1.e-10_r_kind) then rqik_ad = zero else qik_ad = qik_ad+rqik_ad/qsik qsik_ad = qsik_ad-rqik_ad*(qik/(qsik*qsik)) rqik_ad = zero endif advp_ad(k,i) = advp_ad(k,i)+ap_ad ap_ad = zero advq_ad(k,i) = advq_ad(k,i)+aq_ad aq_ad = zero advt_ad(k,i) = advt_ad(k,i)+at_ad at_ad = zero tik_ad = tik_ad+tmt0_ad tmt0_ad = zero if (qsk > epsq) then qsk_ad = qsk_ad+qsik_ad qsik_ad = zero else qsik_ad = zero endif esk_ad = esk_ad+qsk_ad*(eps/(prsk+epsm1*esk)-eps*esk*epsm1/ & ((prsk+epsm1*esk)*(prsk+epsm1*esk))) qsk_ad = zero call fpvsx_ad( tik,esk,tik_ad,esk_ad,adjoint ) esk_ad = zero if (cwmin > climit) then cwmin_ad = cwmin_ad+cwmik_ad cwmik_ad = zero else cwmik_ad = zero endif if (qin > epsq) then qin_ad = qin_ad+qik_ad qik_ad = zero else qik_ad = zero endif q_in_ad(k,i) = q_in_ad(k,i)+qin_ad qin_ad = zero t_in_ad(k,i) = t_in_ad(k,i)+tik_ad tik_ad = zero cwm_in_ad(k,i) = cwm_in_ad(k,i)+cwmin_ad cwmin_ad = zero end do end do return end subroutine gscond_ad