subroutine adcalc_common_factors( bi, bj, imin, imax, jmin, jmax, $k, adutrans, advtrans, adrtrans ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) C============================================== C define arguments C============================================== double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k C============================================== C define local variables C============================================== integer i integer j double precision xa(1-olx:snx+olx,1-oly:sny+oly) double precision ya(1-olx:snx+olx,1-oly:sny+oly) C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do j = jmin, jmax do i = imin, imax xa(i,j) = dyg(i,j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) ya(i,j) = dxg(i,j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) end do end do do j = jmin, jmax do i = imin, imax adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)+adrtrans(i,j)*ra(i, $j,bi,bj) adrtrans(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advtrans(i,j)*ya(i, $j) advtrans(i,j) = 0.d0 aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adutrans(i,j)*xa(i, $j) adutrans(i,j) = 0.d0 end do end do end subroutine adcalc_div_ghat( bi, bj, k, xa, ya, adcg2d_b ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adcg2d_b(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) integer bi integer bj integer k double precision xa(1-olx:snx+olx,1-oly:sny+oly) double precision ya(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define local variables C============================================== double precision adpf(1-olx:snx+olx,1-oly:sny+oly) integer i integer ip1 integer ip2 integer j C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adpf(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do j = 1, sny do i = 1, snx adpf(i,j+1) = adpf(i,j+1)+adcg2d_b(i,j,bi,bj) adpf(i,j) = adpf(i,j)-adcg2d_b(i,j,bi,bj) end do end do if (implicdiv2dflow .eq. 1.) then do j = 1, sny+1 do i = 1, snx adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)+adpf(i,j)*(ya(i, $j)/deltatmom) adpf(i,j) = 0.d0 end do end do else do j = 1, sny+1 do i = 1, snx adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)+adpf(i,j)* $(implicdiv2dflow*ya(i,j)/deltatmom) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+adpf(i,j)*((1.- $implicdiv2dflow)*ya(i,j)/deltatmom) adpf(i,j) = 0.d0 end do end do endif do j = 1, sny do i = 1, snx adpf(i+1,j) = adpf(i+1,j)+adcg2d_b(i,j,bi,bj) adpf(i,j) = adpf(i,j)-adcg2d_b(i,j,bi,bj) end do end do if (implicdiv2dflow .eq. 1.) then do j = 1, sny do i = 1, snx+1 adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)+adpf(i,j)*(xa(i, $j)/deltatmom) adpf(i,j) = 0.d0 end do end do else do j = 1, sny do i = 1, snx+1 adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)+adpf(i,j)* $(implicdiv2dflow*xa(i,j)/deltatmom) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adpf(i,j)*((1.- $implicdiv2dflow)*xa(i,j)/deltatmom) adpf(i,j) = 0.d0 end do end do endif end subroutine adcalc_grad_phi_surf( bi, bj, imin, imax, jmin, jmax, $adetafld, adphisurfx, adphisurfy ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /solve_barot/ bo_surf, recip_bo double precision bo_surf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_bo(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) C============================================== C define arguments C============================================== double precision adetafld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer jmax integer jmin C============================================== C define local variables C============================================== integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do j = jmin, jmax do i = imin, imax adetafld(i,j-1,bi,bj) = adetafld(i,j-1,bi,bj)-adphisurfy(i,j)* $recip_dyc(i,j,bi,bj)*bo_surf(i,j-1,bi,bj) adetafld(i,j,bi,bj) = adetafld(i,j,bi,bj)+adphisurfy(i,j)* $recip_dyc(i,j,bi,bj)*bo_surf(i,j,bi,bj) adphisurfy(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adetafld(i-1,j,bi,bj) = adetafld(i-1,j,bi,bj)-adphisurfx(i,j)* $recip_dxc(i,j,bi,bj)*bo_surf(i-1,j,bi,bj) adetafld(i,j,bi,bj) = adetafld(i,j,bi,bj)+adphisurfx(i,j)* $recip_dxc(i,j,bi,bj)*bo_surf(i,j,bi,bj) adphisurfx(i,j) = 0.d0 end do end do end subroutine adcalc_gs( bi, bj, imin, imax, jmin, jmax, k, km1, kup, $ kdown, xa, ya, utrans, vtrans, rtrans, maskup, maskc, kappars, $adutrans, advtrans, adrtrans, adfvers ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adfvers(1-olx:snx+olx,1-oly:sny+oly,2) double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k double precision kappars(1-olx:snx+olx,1-oly:sny+oly,nr) integer kdown integer km1 integer kup double precision maskc(1-olx:snx+olx,1-oly:sny+oly) double precision maskup(1-olx:snx+olx,1-oly:sny+oly) double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) double precision utrans(1-olx:snx+olx,1-oly:sny+oly) double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) double precision xa(1-olx:snx+olx,1-oly:sny+oly) double precision ya(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define local variables C============================================== double precision adaf(1-olx:snx+olx,1-oly:sny+oly) double precision addf(1-olx:snx+olx,1-oly:sny+oly) double precision addf4(1-olx:snx+olx,1-oly:sny+oly) double precision addsdx(1-olx:snx+olx,1-oly:sny+oly) double precision addsdy(1-olx:snx+olx,1-oly:sny+oly) double precision adfmer(1-olx:snx+olx,1-oly:sny+oly) double precision adfzon(1-olx:snx+olx,1-oly:sny+oly) double precision affacs double precision dffacs integer i integer ip1 integer ip2 integer j logical top_layer C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adaf(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addf(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addf4(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addsdx(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addsdy(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfmer(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfzon(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- affacs = 1.d0 dffacs = 1.d0 top_layer = k .eq. 1 call adexternal_forcing_s( imin,imax,jmin,jmax,bi,bj,k,maskc ) do j = jmin, jmax-1 do i = imin, imax-1 adfmer(i,j+1) = adfmer(i,j+1)-adgs(i,j,k,bi,bj)* $(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adfmer(i,j) = adfmer(i,j)+adgs(i,j,k,bi,bj)*(recip_hfacc(i,j, $k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adfvers(i,j,kdown) = adfvers(i,j,kdown)+adgs(i,j,k,bi,bj)* $recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac adfvers(i,j,kup) = adfvers(i,j,kup)-adgs(i,j,k,bi,bj)* $recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac adfzon(i+1,j) = adfzon(i+1,j)-adgs(i,j,k,bi,bj)* $(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adfzon(i,j) = adfzon(i,j)+adgs(i,j,k,bi,bj)*(recip_hfacc(i,j, $k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adgs(i,j,k,bi,bj) = 0.d0 end do end do if (top_layer) then do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfvers(i,j,kup)*affacs*freesurffac adfvers(i,j,kup) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfvers(i,j,kup)*affacs*maskup(i,j) addf(i,j) = addf(i,j)+adfvers(i,j,kup)*dffacs*maskup(i,j) adfvers(i,j,kup) = 0.d0 end do end do if (implicitdiffusion) then do j = jmin, jmax do i = imin, imax addf(i,j) = 0.d0 end do end do else do j = jmin, jmax do i = imin, imax adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+addf(i,j)*ra(i,j, $bi,bj)*kappars(i,j,k)*recip_drc(k)*rkfac adsalt(i,j,km1,bi,bj) = adsalt(i,j,km1,bi,bj)-addf(i,j)* $ra(i,j,bi,bj)*kappars(i,j,k)*recip_drc(k)*rkfac addf(i,j) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax adrtrans(i,j) = adrtrans(i,j)+0.5d0*adaf(i,j)*(salt(i,j,k,bi, $bj)+salt(i,j,km1,bi,bj)) adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+0.5d0*adaf(i,j)* $rtrans(i,j) adsalt(i,j,km1,bi,bj) = adsalt(i,j,km1,bi,bj)+0.5d0*adaf(i,j)* $rtrans(i,j) adaf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfmer(i,j)*affacs addf(i,j) = addf(i,j)+adfmer(i,j)*dffacs adfmer(i,j) = 0.d0 end do end do if (diffk4s .ne. 0.) then do j = jmin, jmax do i = imin, imax addf4(i,j-1) = addf4(i,j-1)-addf(i,j)*ya(i,j)*diffk4s* $recip_dyc(i,j,bi,bj) addf4(i,j) = addf4(i,j)+addf(i,j)*ya(i,j)*diffk4s* $recip_dyc(i,j,bi,bj) end do end do endif do j = jmin, jmax do i = imin, imax addsdy(i,j) = addsdy(i,j)-addf(i,j)*diffkhs*ya(i,j) addf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adsalt(i,j-1,k,bi,bj) = adsalt(i,j-1,k,bi,bj)+0.5d0*adaf(i,j)* $vtrans(i,j) adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+0.5d0*adaf(i,j)* $vtrans(i,j) advtrans(i,j) = advtrans(i,j)+0.5d0*adaf(i,j)*(salt(i,j,k,bi, $bj)+salt(i,j-1,k,bi,bj)) adaf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfzon(i,j)*affacs addf(i,j) = addf(i,j)+adfzon(i,j)*dffacs adfzon(i,j) = 0.d0 end do end do if (diffk4s .ne. 0.) then do j = jmin, jmax do i = imin, imax addf4(i-1,j) = addf4(i-1,j)-addf(i,j)*xa(i,j)*diffk4s* $recip_dxc(i,j,bi,bj) addf4(i,j) = addf4(i,j)+addf(i,j)*xa(i,j)*diffk4s* $recip_dxc(i,j,bi,bj) end do end do endif do j = jmin, jmax do i = imin, imax addsdx(i,j) = addsdx(i,j)-addf(i,j)*diffkhs*xa(i,j) addf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adsalt(i-1,j,k,bi,bj) = adsalt(i-1,j,k,bi,bj)+0.5d0*adaf(i,j)* $utrans(i,j) adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+0.5d0*adaf(i,j)* $utrans(i,j) adutrans(i,j) = adutrans(i,j)+0.5d0*adaf(i,j)*(salt(i,j,k,bi, $bj)+salt(i-1,j,k,bi,bj)) adaf(i,j) = 0.d0 end do end do if (diffk4s .ne. 0.) then do j = 1-oly+1, sny+oly-1 do i = 1-olx+1, snx+olx-1 addsdx(i+1,j) = addsdx(i+1,j)+addf4(i,j)*recip_hfacc(i,j,k, $bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i+1,j) addsdx(i,j) = addsdx(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, $bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i,j) addsdy(i,j+1) = addsdy(i,j+1)+addf4(i,j)*recip_hfacc(i,j,k, $bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j+1) addsdy(i,j) = addsdy(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, $bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j) addf4(i,j) = 0.d0 end do end do endif do j = 1-oly+1, sny+oly do i = 1-olx, snx+olx adsalt(i,j-1,k,bi,bj) = adsalt(i,j-1,k,bi,bj)-addsdy(i,j)* $recip_dyc(i,j,bi,bj) adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+addsdy(i,j)* $recip_dyc(i,j,bi,bj) addsdy(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly do i = 1-olx+1, snx+olx adsalt(i-1,j,k,bi,bj) = adsalt(i-1,j,k,bi,bj)-addsdx(i,j)* $recip_dxc(i,j,bi,bj) adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+addsdx(i,j)* $recip_dxc(i,j,bi,bj) addsdx(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx adfvers(i,j,kup) = 0.d0 end do end do end subroutine adcalc_gt( bi, bj, imin, imax, jmin, jmax, k, km1, kup, $ kdown, xa, ya, utrans, vtrans, rtrans, maskup, maskc, kappart, $adutrans, advtrans, adrtrans, adfvert ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adfvert(1-olx:snx+olx,1-oly:sny+oly,2) double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k double precision kappart(1-olx:snx+olx,1-oly:sny+oly,nr) integer kdown integer km1 integer kup double precision maskc(1-olx:snx+olx,1-oly:sny+oly) double precision maskup(1-olx:snx+olx,1-oly:sny+oly) double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) double precision utrans(1-olx:snx+olx,1-oly:sny+oly) double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) double precision xa(1-olx:snx+olx,1-oly:sny+oly) double precision ya(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define local variables C============================================== double precision adaf(1-olx:snx+olx,1-oly:sny+oly) double precision addf(1-olx:snx+olx,1-oly:sny+oly) double precision addf4(1-olx:snx+olx,1-oly:sny+oly) double precision addtdx(1-olx:snx+olx,1-oly:sny+oly) double precision addtdy(1-olx:snx+olx,1-oly:sny+oly) double precision adfmer(1-olx:snx+olx,1-oly:sny+oly) double precision adfzon(1-olx:snx+olx,1-oly:sny+oly) double precision affact double precision dffact integer i integer ip1 integer ip2 integer j logical top_layer C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adaf(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addf(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addf4(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addtdx(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addtdy(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfmer(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfzon(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- affact = 1.d0 dffact = 1.d0 top_layer = k .eq. 1 call adexternal_forcing_t( imin,imax,jmin,jmax,bi,bj,k,maskc ) do j = jmin, jmax do i = imin, imax adfmer(i,j+1) = adfmer(i,j+1)-adgt(i,j,k,bi,bj)* $(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adfmer(i,j) = adfmer(i,j)+adgt(i,j,k,bi,bj)*(recip_hfacc(i,j, $k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adfvert(i,j,kdown) = adfvert(i,j,kdown)+adgt(i,j,k,bi,bj)* $recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac adfvert(i,j,kup) = adfvert(i,j,kup)-adgt(i,j,k,bi,bj)* $recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*rkfac adfzon(i+1,j) = adfzon(i+1,j)-adgt(i,j,k,bi,bj)* $(recip_hfacc(i,j,k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adfzon(i,j) = adfzon(i,j)+adgt(i,j,k,bi,bj)*(recip_hfacc(i,j, $k,bi,bj)*recip_drf(k)/ra(i,j,bi,bj)) adgt(i,j,k,bi,bj) = 0.d0 end do end do if (top_layer) then do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfvert(i,j,kup)*affact*freesurffac adfvert(i,j,kup) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfvert(i,j,kup)*affact*maskup(i,j) addf(i,j) = addf(i,j)+adfvert(i,j,kup)*dffact*maskup(i,j) adfvert(i,j,kup) = 0.d0 end do end do if (implicitdiffusion) then do j = jmin, jmax do i = imin, imax addf(i,j) = 0.d0 end do end do else do j = jmin, jmax do i = imin, imax adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+addf(i,j)*ra(i, $j,bi,bj)*kappart(i,j,k)*recip_drc(k)*rkfac adtheta(i,j,km1,bi,bj) = adtheta(i,j,km1,bi,bj)-addf(i,j)* $ra(i,j,bi,bj)*kappart(i,j,k)*recip_drc(k)*rkfac addf(i,j) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax adrtrans(i,j) = adrtrans(i,j)+0.5d0*adaf(i,j)*(theta(i,j,k,bi, $bj)+theta(i,j,km1,bi,bj)) adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+0.5d0*adaf(i,j)* $rtrans(i,j) adtheta(i,j,km1,bi,bj) = adtheta(i,j,km1,bi,bj)+0.5d0*adaf(i, $j)*rtrans(i,j) adaf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfmer(i,j)*affact addf(i,j) = addf(i,j)+adfmer(i,j)*dffact adfmer(i,j) = 0.d0 end do end do if (diffk4t .ne. 0.) then do j = jmin, jmax do i = imin, imax addf4(i,j-1) = addf4(i,j-1)-addf(i,j)*ya(i,j)*diffk4t* $recip_dyc(i,j,bi,bj) addf4(i,j) = addf4(i,j)+addf(i,j)*ya(i,j)*diffk4t* $recip_dyc(i,j,bi,bj) end do end do endif do j = jmin, jmax do i = imin, imax addtdy(i,j) = addtdy(i,j)-addf(i,j)*diffkht*ya(i,j) addf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adtheta(i,j-1,k,bi,bj) = adtheta(i,j-1,k,bi,bj)+0.5d0*adaf(i, $j)*vtrans(i,j) adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+0.5d0*adaf(i,j)* $vtrans(i,j) advtrans(i,j) = advtrans(i,j)+0.5d0*adaf(i,j)*(theta(i,j,k,bi, $bj)+theta(i,j-1,k,bi,bj)) adaf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfzon(i,j)*affact addf(i,j) = addf(i,j)+adfzon(i,j)*dffact adfzon(i,j) = 0.d0 end do end do if (diffk4t .ne. 0.) then do j = jmin, jmax do i = imin, imax addf4(i-1,j) = addf4(i-1,j)-addf(i,j)*xa(i,j)*diffk4t* $recip_dxc(i,j,bi,bj) addf4(i,j) = addf4(i,j)+addf(i,j)*xa(i,j)*diffk4t* $recip_dxc(i,j,bi,bj) end do end do endif do j = jmin, jmax do i = imin, imax addtdx(i,j) = addtdx(i,j)-addf(i,j)*diffkht*xa(i,j) addf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adtheta(i-1,j,k,bi,bj) = adtheta(i-1,j,k,bi,bj)+0.5d0*adaf(i, $j)*utrans(i,j) adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+0.5d0*adaf(i,j)* $utrans(i,j) adutrans(i,j) = adutrans(i,j)+0.5d0*adaf(i,j)*(theta(i,j,k,bi, $bj)+theta(i-1,j,k,bi,bj)) adaf(i,j) = 0.d0 end do end do if (diffk4t .ne. 0.) then do j = 1-oly+1, sny+oly-1 do i = 1-olx+1, snx+olx-1 addtdx(i+1,j) = addtdx(i+1,j)+addf4(i,j)*recip_hfacc(i,j,k, $bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i+1,j) addtdx(i,j) = addtdx(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, $bj)*recip_drf(k)/ra(i,j,bi,bj)*xa(i,j) addtdy(i,j+1) = addtdy(i,j+1)+addf4(i,j)*recip_hfacc(i,j,k, $bi,bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j+1) addtdy(i,j) = addtdy(i,j)-addf4(i,j)*recip_hfacc(i,j,k,bi, $bj)*recip_drf(k)/ra(i,j,bi,bj)*ya(i,j) addf4(i,j) = 0.d0 end do end do endif do j = 1-oly+1, sny+oly do i = 1-olx, snx+olx adtheta(i,j-1,k,bi,bj) = adtheta(i,j-1,k,bi,bj)-addtdy(i,j)* $recip_dyc(i,j,bi,bj) adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+addtdy(i,j)* $recip_dyc(i,j,bi,bj) addtdy(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly do i = 1-olx+1, snx+olx adtheta(i-1,j,k,bi,bj) = adtheta(i-1,j,k,bi,bj)-addtdx(i,j)* $recip_dxc(i,j,bi,bj) adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+addtdx(i,j)* $recip_dxc(i,j,bi,bj) addtdx(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx adfvert(i,j,kup) = 0.d0 end do end do end subroutine adcalc_mom_rhs( bi, bj, imin, imax, jmin, jmax, k, kup, $ kdown, kapparu, kapparv, adphihyd, adfveru, adfverv ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== double precision pi parameter ( pi = 3.1415926535898d0 ) double precision deg2rad parameter ( deg2rad = 2.d0*pi/360.d0 ) integer max_no_threads parameter ( max_no_threads = 32 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, $adgucd, adgvcd double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /solve_barot/ bo_surf, recip_bo double precision bo_surf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_bo(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) C============================================== C define arguments C============================================== double precision adfveru(1-olx:snx+olx,1-oly:sny+oly,2) double precision adfverv(1-olx:snx+olx,1-oly:sny+oly,2) double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) integer kdown integer kup C============================================== C define local variables C============================================== double precision ab05 double precision ab15 double precision adaf(1-olx:snx+olx,1-oly:sny+oly) double precision adfmer(1-olx:snx+olx,1-oly:sny+oly) double precision adfzon(1-olx:snx+olx,1-oly:sny+oly) double precision adke(1-olx:snx+olx,1-oly:sny+oly) double precision admt(1-olx:snx+olx,1-oly:sny+oly) double precision adpf(1-olx:snx+olx,1-oly:sny+oly) double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) double precision adv4f(1-olx:snx+olx,1-oly:sny+oly) double precision advf(1-olx:snx+olx,1-oly:sny+oly) double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) double precision ahdudxfac double precision ahdudyfac double precision ahdvdxfac double precision ahdvdyfac double precision ardudrfac double precision ardvdrfac logical bottomdragterms double precision cosfacu(1-oly:sny+oly) double precision cosfacv(1-oly:sny+oly) double precision fufac double precision fvfac double precision hfacz(1-olx:snx+olx,1-oly:sny+oly) double precision hfaczclosede double precision hfaczclosedn double precision hfaczcloseds double precision hfaczclosedw double precision hfaczopen integer i integer ip1 integer ip2 integer j integer jg double precision ke(1-olx:snx+olx,1-oly:sny+oly) integer kp1 double precision maskdown double precision mtfacu double precision mtfacv double precision phxfac double precision phyfac double precision rdrckp1 double precision rveldudrfac double precision rveldvdrfac double precision rvelmaskoverride double precision ududxfac double precision udvdxfac double precision utrans(1-olx:snx+olx,1-oly:sny+oly) double precision vdudyfac double precision vdvdyfac double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) double precision wvelbottomoverride double precision xa(1-olx:snx+olx,1-oly:sny+oly) double precision ya(1-olx:snx+olx,1-oly:sny+oly) C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adaf(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfmer(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfzon(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adke(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx admt(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adpf(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adutrans(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adv4f(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advf(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advtrans(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- kp1 = min(nr,k+1) rvelmaskoverride = 1. if (k .eq. 1) then rvelmaskoverride = freesurffac endif wvelbottomoverride = 1. if (k .eq. nr) then wvelbottomoverride = 0. endif do j = 1-oly, sny+oly-1 do i = 1-olx, snx+olx-1 ke(i,j) = 0.25*(uvel(i,j,k,bi,bj)*uvel(i,j,k,bi,bj)+uvel(i+1, $j,k,bi,bj)*uvel(i+1,j,k,bi,bj)+vvel(i,j,k,bi,bj)*vvel(i,j,k,bi,bj) $+vvel(i,j+1,k,bi,bj)*vvel(i,j+1,k,bi,bj)) end do end do do j = 1-oly, sny+oly jg = myygloballo+(bj-1)*sny+j-1 jg = min(max(1,jg),ny) if (cospower .ne. 0.) then cosfacu(j) = cos(yc(1,j,bi,bj)*deg2rad)**cospower cosfacv(j) = cos((yc(1,j,bi,bj)-0.5*dely(jg))*deg2rad)** $cospower else cosfacu(j) = 1. cosfacv(j) = 1. endif end do ududxfac = affacmom*1. ahdudxfac = vffacmom*1. vdudyfac = affacmom*1. ahdudyfac = vffacmom*1. rveldudrfac = affacmom*1. ardudrfac = vffacmom*1. mtfacu = mtfacmom*1. fufac = cffacmom*1. phxfac = pffacmom*1. udvdxfac = affacmom*1. ahdvdxfac = vffacmom*1. vdvdyfac = affacmom*1. ahdvdyfac = vffacmom*1. rveldvdrfac = affacmom*1. ardvdrfac = vffacmom*1. mtfacv = mtfacmom*1. fvfac = cffacmom*1. phyfac = pffacmom*1. if (no_slip_bottom) then bottomdragterms = .true. else bottomdragterms = .false. endif if (staggertimestep) then phxfac = 0. phyfac = 0. endif ab15 = 1.5d0+abeps ab05 = (-0.5d0)-abeps do i = 1-olx, snx+olx hfacz(i,1-oly) = 0. end do do j = 2-oly, sny+oly hfacz(1-olx,j) = 0. do i = 2-olx, snx+olx hfaczopen = min(hfacw(i,j,k,bi,bj),hfacw(i,j-1,k,bi,bj)) hfaczopen = min(hfacs(i,j,k,bi,bj),hfaczopen) hfaczopen = min(hfacs(i-1,j,k,bi,bj),hfaczopen) hfacz(i,j) = hfaczopen end do end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx xa(i,j) = dyg(i,j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) ya(i,j) = dxg(i,j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) end do end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx utrans(i,j) = uvel(i,j,k,bi,bj)*xa(i,j) vtrans(i,j) = vvel(i,j,k,bi,bj)*ya(i,j) end do end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advnm1(i,j,k,bi,bj) advnm1(i,j,k,bi,bj) = 0.d0 aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adunm1(i,j,k,bi,bj) adunm1(i,j,k,bi,bj) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)*masks(i,j,k,bi,bj) end do end do do j = jmin, jmax do i = imin, imax adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)*maskw(i,j,k,bi,bj) end do end do do j = jmin, jmax do i = imin, imax aduveld(i,j,k,bi,bj) = aduveld(i,j,k,bi,bj)-0.5d0*adgvcd(i,j, $k,bi,bj)*(fcori(i,j,bi,bj)+fcori(i,j-1,bi,bj))*masks(i,j,k,bi,bj)* $fvfac adgvcd(i,j,k,bi,bj) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adunm1(i+1,j-1,k,bi,bj) = adunm1(i+1,j-1,k,bi,bj)+0.25d0* $aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) adunm1(i,j-1,k,bi,bj) = adunm1(i,j-1,k,bi,bj)+0.25d0* $aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) adunm1(i+1,j,k,bi,bj) = adunm1(i+1,j,k,bi,bj)+0.25d0* $aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) adunm1(i,j,k,bi,bj) = adunm1(i,j,k,bi,bj)+0.25d0*aduveld(i,j, $k,bi,bj)*(1.d0-rcd)*ab05*masks(i,j,k,bi,bj) aduvel(i+1,j-1,k,bi,bj) = aduvel(i+1,j-1,k,bi,bj)+0.25d0* $aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)+0.25d0* $aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+0.25d0* $aduveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*aduveld(i,j, $k,bi,bj)*(1.d0-rcd)*ab15*masks(i,j,k,bi,bj) aduveld(i,j,k,bi,bj) = aduveld(i,j,k,bi,bj)*rcd end do end do do j = jmin, jmax do i = imin, imax advf(i,j) = advf(i,j)+aduveld(i,j,k,bi,bj)*deltatmom*masks(i, $j,k,bi,bj) end do end do do j = jmin, jmax do i = imin, imax adaf(i+1,j-1) = adaf(i+1,j-1)+0.25d0*advf(i,j)*masks(i,j,k,bi, $bj) adaf(i,j-1) = adaf(i,j-1)+0.25d0*advf(i,j)*masks(i,j,k,bi,bj) adaf(i+1,j) = adaf(i+1,j)+0.25d0*advf(i,j)*masks(i,j,k,bi,bj) adaf(i,j) = adaf(i,j)+0.25d0*advf(i,j)*masks(i,j,k,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.5d0*advf(i,j)* $(fcori(i,j,bi,bj)+fcori(i,j-1,bi,bj)) advf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)+adaf(i,j) adpf(i-1,j) = adpf(i-1,j)+adaf(i,j)*maskw(i,j,k,bi,bj)* $recip_dxc(i,j,bi,bj) adpf(i,j) = adpf(i,j)-adaf(i,j)*maskw(i,j,k,bi,bj)* $recip_dxc(i,j,bi,bj) adaf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax advveld(i,j,k,bi,bj) = advveld(i,j,k,bi,bj)+0.5d0*adgucd(i,j, $k,bi,bj)*(fcori(i,j,bi,bj)+fcori(i-1,j,bi,bj))*fufac adgucd(i,j,k,bi,bj) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax advnm1(i-1,j+1,k,bi,bj) = advnm1(i-1,j+1,k,bi,bj)+0.25d0* $advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) advnm1(i,j+1,k,bi,bj) = advnm1(i,j+1,k,bi,bj)+0.25d0* $advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) advnm1(i-1,j,k,bi,bj) = advnm1(i-1,j,k,bi,bj)+0.25d0* $advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) advnm1(i,j,k,bi,bj) = advnm1(i,j,k,bi,bj)+0.25d0*advveld(i,j, $k,bi,bj)*(1.d0-rcd)*ab05*maskw(i,j,k,bi,bj) advvel(i-1,j+1,k,bi,bj) = advvel(i-1,j+1,k,bi,bj)+0.25d0* $advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.25d0* $advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+0.25d0* $advveld(i,j,k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*advveld(i,j, $k,bi,bj)*(1.d0-rcd)*ab15*maskw(i,j,k,bi,bj) advveld(i,j,k,bi,bj) = advveld(i,j,k,bi,bj)*rcd end do end do do j = jmin, jmax do i = imin, imax advf(i,j) = advf(i,j)+advveld(i,j,k,bi,bj)*deltatmom end do end do do j = jmin, jmax do i = imin, imax adaf(i-1,j+1) = adaf(i-1,j+1)+0.25d0*advf(i,j)*maskw(i,j,k,bi, $bj) adaf(i,j+1) = adaf(i,j+1)+0.25d0*advf(i,j)*maskw(i,j,k,bi,bj) adaf(i-1,j) = adaf(i-1,j)+0.25d0*advf(i,j)*maskw(i,j,k,bi,bj) adaf(i,j) = adaf(i,j)+0.25d0*advf(i,j)*maskw(i,j,k,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-0.5d0*advf(i,j)* $(fcori(i,j,bi,bj)+fcori(i-1,j,bi,bj)) advf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)+adaf(i,j) adpf(i,j-1) = adpf(i,j-1)+adaf(i,j)*masks(i,j,k,bi,bj)* $recip_dyc(i,j,bi,bj) adpf(i,j) = adpf(i,j)-adaf(i,j)*masks(i,j,k,bi,bj)* $recip_dyc(i,j,bi,bj) adaf(i,j) = 0.d0 end do end do if (staggertimestep) then do j = jmin, jmax do i = imin, imax adphihyd(i,j,k) = adphihyd(i,j,k)+adpf(i,j) end do end do endif do j = jmin, jmax do i = imin, imax adetan(i,j,bi,bj) = adetan(i,j,bi,bj)+adpf(i,j)*ab15* $bo_surf(i,j,bi,bj) adetanm1(i,j,bi,bj) = adetanm1(i,j,bi,bj)+adpf(i,j)*ab05* $bo_surf(i,j,bi,bj) adpf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)*masks(i,j,k,bi,bj) end do end do if (usingsphericalpolarmterms) then do j = jmin, jmax do i = imin, imax admt(i,j) = admt(i,j)+adgv(i,j,k,bi,bj)*mtfacv end do end do do j = jmin, jmax do i = imin, imax aduvel(i+1,j-1,k,bi,bj) = aduvel(i+1,j-1,k,bi,bj)-0.125d0* $admt(i,j)*recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+ $uvel(i,j-1,k,bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)-0.125d0* $admt(i,j)*recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+ $uvel(i,j-1,k,bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)-0.125d0* $admt(i,j)*recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+ $uvel(i,j-1,k,bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-0.125d0*admt(i,j)* $recip_rsphere*(uvel(i,j,k,bi,bj)+uvel(i+1,j,k,bi,bj)+uvel(i,j-1,k, $bi,bj)+uvel(i+1,j-1,k,bi,bj))*tanphiatv(i,j,bi,bj) end do end do do j = jmin, jmax do i = imin, imax advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* $recip_rsphere*(wvelbottomoverride*(wvel(i,j,kp1,bi,bj)+wvel(i,j-1, $kp1,bi,bj))+wvel(i,j,k,bi,bj)+wvel(i,j-1,k,bi,bj))*rkfac* $recip_horivertratio adwvel(i,j-1,k,bi,bj) = adwvel(i,j-1,k,bi,bj)-0.25d0*admt(i, $j)*vvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio adwvel(i,j-1,kp1,bi,bj) = adwvel(i,j-1,kp1,bi,bj)-0.25d0* $admt(i,j)*vvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride* $rkfac*recip_horivertratio adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* $vvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)-0.25d0*admt(i, $j)*vvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride*rkfac* $recip_horivertratio admt(i,j) = 0.d0 end do end do endif call adexternal_forcing_v( imin,imax,jmin,jmax,bi,bj,k ) if (bottomdragterms) then rdrckp1 = recip_drc(kp1) if (k .eq. nr) then rdrckp1 = recip_drf(k) endif do j = jmin, jmax do i = imin, imax maskdown = masks(i,j,kp1,bi,bj) if (k .eq. nr) then maskdown = 0. endif if (ke(i,j)+ke(i,j-1) .ne. 0.) then adke(i,j-1) = adke(i,j-1)-adgv(i,j,k,bi,bj)*recip_hfacs(i, $j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ $ke(i,j-1)))*(1.-maskdown)*vvel(i,j,k,bi,bj) adke(i,j) = adke(i,j)-adgv(i,j,k,bi,bj)*recip_hfacs(i,j,k, $bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ke(i, $j-1)))*(1.-maskdown)*vvel(i,j,k,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-adgv(i,j,k,bi, $bj)*recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*(1.- $maskdown)*sqrt(ke(i,j)+ke(i,j-1)) endif advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-adgv(i,j,k,bi,bj)* $recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*(2.*kapparv(i,j,kp1)*rkfac* $rdrckp1+bottomdraglinear)*(1.-maskdown) end do end do endif if (no_slip_sides) then do j = jmin, jmax do i = imin, imax hfaczclosedw = hfacs(i,j,k,bi,bj)-hfacz(i,j) hfaczclosede = hfacs(i,j,k,bi,bj)-hfacz(i+1,j) adv4f(i,j) = adv4f(i,j)+2.*adgv(i,j,k,bi,bj)*recip_hfacs(i, $j,k,bi,bj)*recip_drf(k)/ras(i,j,bi,bj)*(hfaczclosedw*dyu(i,j,bi, $bj)*recip_dxv(i,j,bi,bj)+hfaczclosede*dyu(i+1,j,bi,bj)* $recip_dxv(i+1,j,bi,bj))*rkfac*drf(k)*visca4*cosfacv(j) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-2.*adgv(i,j,k,bi, $bj)*recip_hfacs(i,j,k,bi,bj)*recip_drf(k)/ras(i,j,bi,bj)* $(hfaczclosedw*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj)+hfaczclosede* $dyu(i+1,j,bi,bj)*recip_dxv(i+1,j,bi,bj))*rkfac*drf(k)*viscah* $cosfacv(j) end do end do endif do j = jmin, jmax do i = imin, imax adfmer(i,j-1) = adfmer(i,j-1)+adgv(i,j,k,bi,bj)*recip_hfacs(i, $j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) adfmer(i,j) = adfmer(i,j)-adgv(i,j,k,bi,bj)*recip_hfacs(i,j,k, $bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) adfverv(i,j,kdown) = adfverv(i,j,kdown)+adgv(i,j,k,bi,bj)* $recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj)*rkfac adfverv(i,j,kup) = adfverv(i,j,kup)-adgv(i,j,k,bi,bj)* $recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj)*rkfac adfzon(i+1,j) = adfzon(i+1,j)-adgv(i,j,k,bi,bj)*recip_hfacs(i, $j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) adfzon(i,j) = adfzon(i,j)+adgv(i,j,k,bi,bj)*recip_hfacs(i,j,k, $bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj) adpf(i,j) = adpf(i,j)+adgv(i,j,k,bi,bj)*phyfac adgv(i,j,k,bi,bj) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adphihyd(i,j-1,k) = adphihyd(i,j-1,k)+adpf(i,j)*recip_dyc(i,j, $bi,bj) adphihyd(i,j,k) = adphihyd(i,j,k)-adpf(i,j)*recip_dyc(i,j,bi, $bj) adpf(i,j) = 0.d0 end do end do if (implicitviscosity) then do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfverv(i,j,kdown)*rveldvdrfac adfverv(i,j,kdown) = 0.d0 end do end do else do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfverv(i,j,kdown)*rveldvdrfac advf(i,j) = advf(i,j)+adfverv(i,j,kdown)*ardvdrfac adfverv(i,j,kdown) = 0.d0 end do end do endif if ( .not. implicitviscosity) then do j = jmin, jmax do i = imin, imax advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-advf(i,j)* $kapparv(i,j,kp1)*ras(i,j,bi,bj)*rkfac*recip_drc(kp1)*masks(i,j, $kp1,bi,bj) advvel(i,j,kp1,bi,bj) = advvel(i,j,kp1,bi,bj)+advf(i,j)* $kapparv(i,j,kp1)*ras(i,j,bi,bj)*rkfac*recip_drc(kp1)*masks(i,j, $kp1,bi,bj) advf(i,j) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* $wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i,j-1, $kp1,bi,bj)*ra(i,j-1,bi,bj)) advvel(i,j,kp1,bi,bj) = advvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) $*wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i,j-1, $kp1,bi,bj)*ra(i,j-1,bi,bj)) adwvel(i,j-1,kp1,bi,bj) = adwvel(i,j-1,kp1,bi,bj)+0.25d0* $adaf(i,j)*wvelbottomoverride*ra(i,j-1,bi,bj)*(vvel(i,j,kp1,bi,bj)+ $vvel(i,j,k,bi,bj)) adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) $*wvelbottomoverride*ra(i,j,bi,bj)*(vvel(i,j,kp1,bi,bj)+vvel(i,j,k, $bi,bj)) adaf(i,j) = 0.d0 end do end do if (k .eq. 1) then do j = jmin, jmax do i = imin, imax advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.5*adfverv(i,j, $kup)*rvelmaskoverride*(wvel(i,j,k,bi,bj)*ra(i,j,bi,bj)+wvel(i,j-1, $k,bi,bj)*ra(i,j-1,bi,bj)) adwvel(i,j-1,k,bi,bj) = adwvel(i,j-1,k,bi,bj)+0.5*adfverv(i, $j,kup)*rvelmaskoverride*ra(i,j-1,bi,bj)*vvel(i,j,k,bi,bj) adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)+0.5*adfverv(i,j, $kup)*rvelmaskoverride*ra(i,j,bi,bj)*vvel(i,j,k,bi,bj) adfverv(i,j,kup) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfmer(i,j)*vdvdyfac advf(i,j) = advf(i,j)+adfmer(i,j)*ahdvdyfac adfmer(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adv4f(i,j+1) = adv4f(i,j+1)+advf(i,j)*dxf(i,j,bi,bj)*drf(k)* $hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dyf(i,j,bi,bj) adv4f(i,j) = adv4f(i,j)-advf(i,j)*dxf(i,j,bi,bj)*drf(k)* $hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dyf(i,j,bi,bj) advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)-advf(i,j)*dxf(i, $j,bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dyf(i, $j,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advf(i,j)*dxf(i,j, $bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dyf(i,j, $bi,bj) advf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax advtrans(i,j+1) = advtrans(i,j+1)+0.25d0*adaf(i,j)*(vvel(i,j, $k,bi,bj)+vvel(i,j+1,k,bi,bj)) advtrans(i,j) = advtrans(i,j)+0.25d0*adaf(i,j)*(vvel(i,j,k,bi, $bj)+vvel(i,j+1,k,bi,bj)) advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.25d0*adaf(i,j) $*(vtrans(i,j)+vtrans(i,j+1)) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* $(vtrans(i,j)+vtrans(i,j+1)) adaf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfzon(i,j)*udvdxfac advf(i,j) = advf(i,j)+adfzon(i,j)*ahdvdxfac adfzon(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adv4f(i-1,j) = adv4f(i-1,j)-advf(i,j)*dyu(i,j,bi,bj)*drf(k)* $hfacz(i,j)*visca4*cosfacv(j)*recip_dxv(i,j,bi,bj) adv4f(i,j) = adv4f(i,j)+advf(i,j)*dyu(i,j,bi,bj)*drf(k)* $hfacz(i,j)*visca4*cosfacv(j)*recip_dxv(i,j,bi,bj) advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+advf(i,j)*dyu(i, $j,bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dxv(i,j,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-advf(i,j)*dyu(i,j, $bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dxv(i,j,bi,bj) advf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adutrans(i,j-1) = adutrans(i,j-1)+0.25d0*adaf(i,j)*(vvel(i,j, $k,bi,bj)+vvel(i-1,j,k,bi,bj)) adutrans(i,j) = adutrans(i,j)+0.25d0*adaf(i,j)*(vvel(i,j,k,bi, $bj)+vvel(i-1,j,k,bi,bj)) advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+0.25d0*adaf(i,j) $*(utrans(i,j)+utrans(i,j-1)) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* $(utrans(i,j)+utrans(i,j-1)) adaf(i,j) = 0.d0 end do end do if (no_slip_sides) then do j = 0, sny+2 do i = 0, snx+1 hfaczclosedw = hfacs(i,j,k,bi,bj)-hfacz(i,j) hfaczclosede = hfacs(i,j,k,bi,bj)-hfacz(i+1,j) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-2*adv4f(i,j)* $recip_hfacs(i,j,k,bi,bj)*recip_drf(k)*recip_ras(i,j,bi,bj)* $(hfaczclosedw*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj)+hfaczclosede* $dyu(i+1,j,bi,bj)*recip_dxv(i+1,j,bi,bj))*drf(k)*masks(i,j,k,bi,bj) end do end do endif do j = 0, sny+2 do i = 0, snx+1 adfmer(i,j-1) = adfmer(i,j-1)-adv4f(i,j)*recip_drf(k)* $recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) adfmer(i,j) = adfmer(i,j)+adv4f(i,j)*recip_drf(k)* $recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) adfzon(i+1,j) = adfzon(i+1,j)+adv4f(i,j)*recip_drf(k)* $recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) adfzon(i,j) = adfzon(i,j)-adv4f(i,j)*recip_drf(k)* $recip_hfacs(i,j,k,bi,bj)*recip_ras(i,j,bi,bj)*masks(i,j,k,bi,bj) adv4f(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly-1 do i = 1-olx, snx+olx advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+adfmer(i,j)* $drf(k)*hfacc(i,j,k,bi,bj)*dxf(i,j,bi,bj)*recip_dyf(i,j,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)-adfmer(i,j)*drf(k)* $hfacc(i,j,k,bi,bj)*dxf(i,j,bi,bj)*recip_dyf(i,j,bi,bj) adfmer(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly do i = 1-olx+1, snx+olx advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)-adfzon(i,j)* $drf(k)*hfacz(i,j)*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+adfzon(i,j)*drf(k)* $hfacz(i,j)*dyu(i,j,bi,bj)*recip_dxv(i,j,bi,bj) adfzon(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)*maskw(i,j,k,bi,bj) end do end do if (usingsphericalpolarmterms) then do j = jmin, jmax do i = imin, imax admt(i,j) = admt(i,j)+adgu(i,j,k,bi,bj)*mtfacu end do end do do j = jmin, jmax do i = imin, imax aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*admt(i,j)* $recip_rsphere*(vvel(i,j,k,bi,bj)+vvel(i-1,j,k,bi,bj)+vvel(i,j+1,k, $bi,bj)+vvel(i-1,j+1,k,bi,bj))*tanphiatu(i,j,bi,bj) advvel(i-1,j+1,k,bi,bj) = advvel(i-1,j+1,k,bi,bj)+0.25d0* $admt(i,j)*uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.25d0*admt(i, $j)*uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) advvel(i-1,j,k,bi,bj) = advvel(i-1,j,k,bi,bj)+0.25d0*admt(i, $j)*uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.25d0*admt(i,j)* $uvel(i,j,k,bi,bj)*recip_rsphere*tanphiatu(i,j,bi,bj) end do end do do j = jmin, jmax do i = imin, imax aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* $recip_rsphere*(wvelbottomoverride*(wvel(i-1,j,kp1,bi,bj)+wvel(i,j, $kp1,bi,bj))+wvel(i-1,j,k,bi,bj)+wvel(i,j,k,bi,bj))*rkfac* $recip_horivertratio adwvel(i-1,j,k,bi,bj) = adwvel(i-1,j,k,bi,bj)-0.25d0*admt(i, $j)*uvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)-0.25d0*admt(i,j)* $uvel(i,j,k,bi,bj)*recip_rsphere*rkfac*recip_horivertratio adwvel(i-1,j,kp1,bi,bj) = adwvel(i-1,j,kp1,bi,bj)-0.25d0* $admt(i,j)*uvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride* $rkfac*recip_horivertratio adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)-0.25d0*admt(i, $j)*uvel(i,j,k,bi,bj)*recip_rsphere*wvelbottomoverride*rkfac* $recip_horivertratio admt(i,j) = 0.d0 end do end do endif call adexternal_forcing_u( imin,imax,jmin,jmax,bi,bj,k ) if (bottomdragterms) then rdrckp1 = recip_drc(kp1) if (k .eq. nr) then rdrckp1 = recip_drf(k) endif do j = jmin, jmax do i = imin, imax maskdown = maskw(i,j,kp1,bi,bj) if (k .eq. nr) then maskdown = 0.d0 endif if (ke(i,j)+ke(i-1,j) .ne. 0.) then adke(i-1,j) = adke(i-1,j)-adgu(i,j,k,bi,bj)*recip_hfacw(i, $j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ $ke(i-1,j)))*(1.-maskdown)*uvel(i,j,k,bi,bj) adke(i,j) = adke(i,j)-adgu(i,j,k,bi,bj)*recip_hfacw(i,j,k, $bi,bj)*recip_drf(k)*bottomdragquadratic*1./(2.*sqrt(ke(i,j)+ke(i- $1,j)))*(1.-maskdown)*uvel(i,j,k,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-adgu(i,j,k,bi, $bj)*recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*bottomdragquadratic*(1.- $maskdown)*sqrt(ke(i,j)+ke(i-1,j)) endif aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-adgu(i,j,k,bi,bj)* $recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*(2.*kapparu(i,j,kp1)*rkfac* $rdrckp1+bottomdraglinear)*(1.-maskdown) end do end do endif if (no_slip_sides) then do j = jmin, jmax do i = imin, imax hfaczcloseds = hfacw(i,j,k,bi,bj)-hfacz(i,j) hfaczclosedn = hfacw(i,j,k,bi,bj)-hfacz(i,j+1) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-2.*adgu(i,j,k,bi, $bj)*recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)* $(hfaczcloseds*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj)+hfaczclosedn* $dxv(i,j+1,bi,bj)*recip_dyu(i,j+1,bi,bj))*drf(k)*viscah*cosfacu(j) adv4f(i,j) = adv4f(i,j)+2.*adgu(i,j,k,bi,bj)*recip_hfacw(i, $j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)*(hfaczcloseds*dxv(i, $j,bi,bj)*recip_dyu(i,j,bi,bj)+hfaczclosedn*dxv(i,j+1,bi,bj)* $recip_dyu(i,j+1,bi,bj))*drf(k)*visca4*cosfacu(j) end do end do endif do j = jmin, jmax do i = imin, imax adfmer(i,j+1) = adfmer(i,j+1)-adgu(i,j,k,bi,bj)*recip_hfacw(i, $j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) adfmer(i,j) = adfmer(i,j)+adgu(i,j,k,bi,bj)*recip_hfacw(i,j,k, $bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) adfveru(i,j,kdown) = adfveru(i,j,kdown)+adgu(i,j,k,bi,bj)* $recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)*rkfac adfveru(i,j,kup) = adfveru(i,j,kup)-adgu(i,j,k,bi,bj)* $recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)*rkfac adfzon(i-1,j) = adfzon(i-1,j)+adgu(i,j,k,bi,bj)*recip_hfacw(i, $j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) adfzon(i,j) = adfzon(i,j)-adgu(i,j,k,bi,bj)*recip_hfacw(i,j,k, $bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj) adpf(i,j) = adpf(i,j)+adgu(i,j,k,bi,bj)*phxfac adgu(i,j,k,bi,bj) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adphihyd(i-1,j,k) = adphihyd(i-1,j,k)+adpf(i,j)*recip_dxc(i,j, $bi,bj) adphihyd(i,j,k) = adphihyd(i,j,k)-adpf(i,j)*recip_dxc(i,j,bi, $bj) adpf(i,j) = 0.d0 end do end do if (implicitviscosity) then do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfveru(i,j,kdown)*rveldudrfac adfveru(i,j,kdown) = 0.d0 end do end do else do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfveru(i,j,kdown)*rveldudrfac advf(i,j) = advf(i,j)+adfveru(i,j,kdown)*ardudrfac adfveru(i,j,kdown) = 0.d0 end do end do endif if ( .not. implicitviscosity) then do j = jmin, jmax do i = imin, imax aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-advf(i,j)* $kapparu(i,j,kp1)*raw(i,j,bi,bj)*rkfac*recip_drc(kp1)*maskw(i,j, $kp1,bi,bj) aduvel(i,j,kp1,bi,bj) = aduvel(i,j,kp1,bi,bj)+advf(i,j)* $kapparu(i,j,kp1)*raw(i,j,bi,bj)*rkfac*recip_drc(kp1)*maskw(i,j, $kp1,bi,bj) advf(i,j) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* $wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i-1,j, $kp1,bi,bj)*ra(i-1,j,bi,bj)) aduvel(i,j,kp1,bi,bj) = aduvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) $*wvelbottomoverride*(wvel(i,j,kp1,bi,bj)*ra(i,j,bi,bj)+wvel(i-1,j, $kp1,bi,bj)*ra(i-1,j,bi,bj)) adwvel(i-1,j,kp1,bi,bj) = adwvel(i-1,j,kp1,bi,bj)+0.25d0* $adaf(i,j)*wvelbottomoverride*ra(i-1,j,bi,bj)*(uvel(i,j,kp1,bi,bj)+ $uvel(i,j,k,bi,bj)) adwvel(i,j,kp1,bi,bj) = adwvel(i,j,kp1,bi,bj)+0.25d0*adaf(i,j) $*wvelbottomoverride*ra(i,j,bi,bj)*(uvel(i,j,kp1,bi,bj)+uvel(i,j,k, $bi,bj)) adaf(i,j) = 0.d0 end do end do if (k .eq. 1) then do j = jmin, jmax do i = imin, imax aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.5*adfveru(i,j, $kup)*rvelmaskoverride*(wvel(i,j,k,bi,bj)*ra(i,j,bi,bj)+wvel(i-1,j, $k,bi,bj)*ra(i-1,j,bi,bj)) adwvel(i-1,j,k,bi,bj) = adwvel(i-1,j,k,bi,bj)+0.5*adfveru(i, $j,kup)*rvelmaskoverride*ra(i-1,j,bi,bj)*uvel(i,j,k,bi,bj) adwvel(i,j,k,bi,bj) = adwvel(i,j,k,bi,bj)+0.5*adfveru(i,j, $kup)*rvelmaskoverride*ra(i,j,bi,bj)*uvel(i,j,k,bi,bj) adfveru(i,j,kup) = 0.d0 end do end do endif do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfmer(i,j)*vdudyfac advf(i,j) = advf(i,j)+adfmer(i,j)*ahdudyfac adfmer(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)+advf(i,j)*dxv(i, $j,bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dyu(i,j,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-advf(i,j)*dxv(i,j, $bi,bj)*drf(k)*hfacz(i,j)*viscah*cosfacv(j)*recip_dyu(i,j,bi,bj) adv4f(i,j-1) = adv4f(i,j-1)-advf(i,j)*dxv(i,j,bi,bj)*drf(k)* $hfacz(i,j)*visca4*cosfacv(j)*recip_dyu(i,j,bi,bj) adv4f(i,j) = adv4f(i,j)+advf(i,j)*dxv(i,j,bi,bj)*drf(k)* $hfacz(i,j)*visca4*cosfacv(j)*recip_dyu(i,j,bi,bj) advf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)+0.25d0*adaf(i,j) $*(vtrans(i,j)+vtrans(i-1,j)) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* $(vtrans(i,j)+vtrans(i-1,j)) advtrans(i-1,j) = advtrans(i-1,j)+0.25d0*adaf(i,j)*(uvel(i,j, $k,bi,bj)+uvel(i,j-1,k,bi,bj)) advtrans(i,j) = advtrans(i,j)+0.25d0*adaf(i,j)*(uvel(i,j,k,bi, $bj)+uvel(i,j-1,k,bi,bj)) adaf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adaf(i,j) = adaf(i,j)+adfzon(i,j)*ududxfac advf(i,j) = advf(i,j)+adfzon(i,j)*ahdudxfac adfzon(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)-advf(i,j)*dyf(i, $j,bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dxf(i, $j,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+advf(i,j)*dyf(i,j, $bi,bj)*drf(k)*hfacc(i,j,k,bi,bj)*viscah*cosfacu(j)*recip_dxf(i,j, $bi,bj) adv4f(i+1,j) = adv4f(i+1,j)+advf(i,j)*dyf(i,j,bi,bj)*drf(k)* $hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dxf(i,j,bi,bj) adv4f(i,j) = adv4f(i,j)-advf(i,j)*dyf(i,j,bi,bj)*drf(k)* $hfacc(i,j,k,bi,bj)*visca4*cosfacu(j)*recip_dxf(i,j,bi,bj) advf(i,j) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adutrans(i+1,j) = adutrans(i+1,j)+0.25d0*adaf(i,j)*(uvel(i,j, $k,bi,bj)+uvel(i+1,j,k,bi,bj)) adutrans(i,j) = adutrans(i,j)+0.25d0*adaf(i,j)*(uvel(i,j,k,bi, $bj)+uvel(i+1,j,k,bi,bj)) aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+0.25d0*adaf(i,j) $*(utrans(i,j)+utrans(i+1,j)) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.25d0*adaf(i,j)* $(utrans(i,j)+utrans(i+1,j)) adaf(i,j) = 0.d0 end do end do if (no_slip_sides) then do j = 0, sny+1 do i = 0, snx+2 hfaczcloseds = hfacw(i,j,k,bi,bj)-hfacz(i,j) hfaczclosedn = hfacw(i,j,k,bi,bj)-hfacz(i,j+1) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-2*adv4f(i,j)* $recip_hfacw(i,j,k,bi,bj)*recip_drf(k)*recip_raw(i,j,bi,bj)* $(hfaczcloseds*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj)+hfaczclosedn* $dxv(i,j+1,bi,bj)*recip_dyu(i,j+1,bi,bj))*drf(k)*maskw(i,j,k,bi,bj) end do end do endif do j = 0, sny+1 do i = 0, snx+2 adfmer(i,j+1) = adfmer(i,j+1)+adv4f(i,j)*recip_drf(k)* $recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) adfmer(i,j) = adfmer(i,j)-adv4f(i,j)*recip_drf(k)* $recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) adfzon(i-1,j) = adfzon(i-1,j)-adv4f(i,j)*recip_drf(k)* $recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) adfzon(i,j) = adfzon(i,j)+adv4f(i,j)*recip_drf(k)* $recip_hfacw(i,j,k,bi,bj)*recip_raw(i,j,bi,bj)*maskw(i,j,k,bi,bj) adv4f(i,j) = 0.d0 end do end do do j = 1-oly+1, sny+oly do i = 1-olx, snx+olx aduvel(i,j-1,k,bi,bj) = aduvel(i,j-1,k,bi,bj)-adfmer(i,j)* $drf(k)*hfacz(i,j)*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adfmer(i,j)*drf(k)* $hfacz(i,j)*dxv(i,j,bi,bj)*recip_dyu(i,j,bi,bj) adfmer(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx-1 aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+adfzon(i,j)* $drf(k)*hfacc(i,j,k,bi,bj)*dyf(i,j,bi,bj)*recip_dxf(i,j,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)-adfzon(i,j)*drf(k)* $hfacc(i,j,k,bi,bj)*dyf(i,j,bi,bj)*recip_dxf(i,j,bi,bj) adfzon(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+advtrans(i,j)*ya(i, $j) advtrans(i,j) = 0.d0 aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adutrans(i,j)*xa(i, $j) adutrans(i,j) = 0.d0 end do end do do j = 1-oly, sny+oly-1 do i = 1-olx, snx+olx-1 aduvel(i+1,j,k,bi,bj) = aduvel(i+1,j,k,bi,bj)+0.5*adke(i,j)* $uvel(i+1,j,k,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+0.5*adke(i,j)* $uvel(i,j,k,bi,bj) advvel(i,j+1,k,bi,bj) = advvel(i,j+1,k,bi,bj)+0.5*adke(i,j)* $vvel(i,j+1,k,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+0.5*adke(i,j)* $vvel(i,j,k,bi,bj) adke(i,j) = 0.d0 end do end do end subroutine mdcalc_phi_hyd( bi, bj, imin, imax, jmin, jmax, k, $theta, salt, phihyd, mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_len_fnam parameter ( max_len_fnam = 512 ) integer max_no_threads parameter ( max_no_threads = 32 ) integer maxnochkptlev parameter ( maxnochkptlev = 2 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /cadsalv/ salth real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetc/ thetah real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_c/ checkptsuff, bathyfile, hydrogthetafile, $hydrogsaltfile, zonalwindfile, meridwindfile, thetaclimfile, $saltclimfile, buoyancyrelation, empmrfile, surfqfile, surfqswfile, $ uvelinitfile, vvelinitfile, psurfinitfile, dqdtfile character*(max_len_fnam) bathyfile character*(max_len_fnam) buoyancyrelation character*(5) checkptsuff(maxnochkptlev) character*(max_len_fnam) dqdtfile character*(max_len_fnam) empmrfile character*(max_len_fnam) hydrogsaltfile character*(max_len_fnam) hydrogthetafile character*(max_len_fnam) meridwindfile character*(max_len_fnam) psurfinitfile character*(max_len_fnam) saltclimfile character*(max_len_fnam) surfqfile character*(max_len_fnam) surfqswfile character*(max_len_fnam) thetaclimfile character*(max_len_fnam) uvelinitfile character*(max_len_fnam) vvelinitfile character*(max_len_fnam) zonalwindfile common /parm_eos_lin/ talpha, sbeta, eostype character*(6) eostype double precision sbeta double precision talpha common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, $ikey_daily_2, iloop_daily integer ikey_daily_1 integer ikey_daily_2 integer ikey_dynamics integer ikey_yearly integer iloop_daily common /tamckeys/ key, ikey, idkey integer idkey integer ikey integer key C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer k integer mythid double precision phihyd(1-olx:snx+olx,1-oly:sny+oly,nr) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) C============================================== C define local variables C============================================== integer act1 integer act2 integer act3 integer act4 double precision alpharho(1-olx:snx+olx,1-oly:sny+oly) double precision atm_cp double precision atm_kappa double precision atm_po double precision ddrm double precision ddrm1 double precision ddrp double precision ddrp1 double precision drloc double precision drlockp1 integer i integer ip1 integer ip2 integer j integer kkey integer max1 integer max2 integer max3 C********************************************** C executable statements of routine C********************************************** act1 = bi-mybxlo(mythid) max1 = mybxhi(mythid)-mybxlo(mythid)+1 act2 = bj-mybylo(mythid) max2 = mybyhi(mythid)-mybylo(mythid)+1 act3 = mythid-1 max3 = ntx*nty act4 = ikey_dynamics-1 ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 if (buoyancyrelation .eq. 'OCEANIC') then drloc = drc(k) if (k .eq. 1) then drloc = drf(1) endif if (k .eq. nr) then drlockp1 = 0. else drlockp1 = drc(k+1) endif if (k .eq. 1) then do j = jmin, jmax do i = imin, imax phihyd(i,j,k) = 0. end do end do endif kkey = (ikey-1)*nr+k do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) thetah(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly,k,bi, $bj) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salth(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) end do end do call find_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype,theta,salt, $alpharho,mythid ) do j = jmin, jmax do i = imin, imax phihyd(i,j,k) = phihyd(i,j,k)+0.5*drloc*gravity*alpharho(i, $j)*recip_rhoconst if (k .lt. nr) then phihyd(i,j,k+1) = phihyd(i,j,k)+0.5*drlockp1*gravity* $alpharho(i,j)*recip_rhoconst endif end do end do else if (buoyancyrelation .eq. 'ATMOSPHERIC') then atm_cp = 1004.d0 atm_kappa = 2.d0/7.d0 atm_po = 1.d+5 if (k .eq. 1) then ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rf(k)/atm_po)** $atm_kappa) do j = jmin, jmax do i = imin, imax ddrp = ddrp1 if (hfacc(i,j,k,bi,bj) .eq. 0.) then ddrp = 0. endif phihyd(i,j,k) = 0.-ddrp*(theta(i,j,k,bi,bj)-tref(k)) end do end do else ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rc(k-1)/atm_po)** $atm_kappa)*0.5 ddrm1 = ddrp1 do j = jmin, jmax do i = imin, imax ddrp = ddrp1 ddrm = ddrm1 if (hfacc(i,j,k,bi,bj) .eq. 0.) then ddrp = 0. endif if (hfacc(i,j,k-1,bi,bj) .eq. 0.) then ddrm = 0. endif phihyd(i,j,k) = phihyd(i,j,k-1)-(ddrm*(theta(i,j,k-1,bi, $bj)-tref(k-1))+ddrp*(theta(i,j,k,bi,bj)-tref(k))) end do end do endif endif end subroutine adcalc_phi_hyd( bi, bj, imin, imax, jmin, jmax, k, $mythid, adtheta, adsalt, adphihyd ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_len_fnam parameter ( max_len_fnam = 512 ) integer max_no_threads parameter ( max_no_threads = 32 ) integer maxnochkptlev parameter ( maxnochkptlev = 2 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /cadsalv/ salth real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetc/ thetah real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_c/ checkptsuff, bathyfile, hydrogthetafile, $hydrogsaltfile, zonalwindfile, meridwindfile, thetaclimfile, $saltclimfile, buoyancyrelation, empmrfile, surfqfile, surfqswfile, $ uvelinitfile, vvelinitfile, psurfinitfile, dqdtfile character*(max_len_fnam) bathyfile character*(max_len_fnam) buoyancyrelation character*(5) checkptsuff(maxnochkptlev) character*(max_len_fnam) dqdtfile character*(max_len_fnam) empmrfile character*(max_len_fnam) hydrogsaltfile character*(max_len_fnam) hydrogthetafile character*(max_len_fnam) meridwindfile character*(max_len_fnam) psurfinitfile character*(max_len_fnam) saltclimfile character*(max_len_fnam) surfqfile character*(max_len_fnam) surfqswfile character*(max_len_fnam) thetaclimfile character*(max_len_fnam) uvelinitfile character*(max_len_fnam) vvelinitfile character*(max_len_fnam) zonalwindfile common /parm_eos_lin/ talpha, sbeta, eostype character*(6) eostype double precision sbeta double precision talpha common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, $ikey_daily_2, iloop_daily integer ikey_daily_1 integer ikey_daily_2 integer ikey_dynamics integer ikey_yearly integer iloop_daily common /tamckeys/ key, ikey, idkey integer idkey integer ikey integer key C============================================== C define arguments C============================================== double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k integer mythid C============================================== C define local variables C============================================== integer act1 integer act2 integer act3 integer act4 double precision adalpharho(1-olx:snx+olx,1-oly:sny+oly) double precision adphihydh double precision atm_cp double precision atm_kappa double precision atm_po double precision ddrm double precision ddrm1 double precision ddrp double precision ddrp1 double precision drloc double precision drlockp1 integer i integer ip1 integer ip2 integer j integer kkey integer max1 integer max2 integer max3 double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adalpharho(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- act1 = bi-mybxlo(mythid) max1 = mybxhi(mythid)-mybxlo(mythid)+1 act2 = bj-mybylo(mythid) max2 = mybyhi(mythid)-mybylo(mythid)+1 act3 = mythid-1 max3 = ntx*nty act4 = ikey_dynamics-1 ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 if (buoyancyrelation .eq. 'OCEANIC') then drloc = drc(k) if (k .eq. 1) then drloc = drf(1) endif if (k .eq. nr) then drlockp1 = 0. else drlockp1 = drc(k+1) endif kkey = (ikey-1)*nr+k do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) theta(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = thetah(ip1,ip2, $kkey) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = salth(ip1,ip2,kkey) end do end do do j = jmin, jmax do i = imin, imax if (k .lt. nr) then adalpharho(i,j) = adalpharho(i,j)+0.5*adphihyd(i,j,k+1)* $drlockp1*gravity*recip_rhoconst adphihyd(i,j,k) = adphihyd(i,j,k)+adphihyd(i,j,k+1) adphihyd(i,j,k+1) = 0.d0 endif adphihydh = adphihyd(i,j,k) adphihyd(i,j,k) = 0.d0 adalpharho(i,j) = adalpharho(i,j)+0.5*adphihydh*drloc* $gravity*recip_rhoconst adphihyd(i,j,k) = adphihyd(i,j,k)+adphihydh end do end do call adfind_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype,theta, $salt,adtheta,adsalt,adalpharho ) if (k .eq. 1) then do j = jmin, jmax do i = imin, imax adphihyd(i,j,k) = 0.d0 end do end do endif else if (buoyancyrelation .eq. 'ATMOSPHERIC') then atm_cp = 1004.d0 atm_kappa = 2.d0/7.d0 atm_po = 1.d+5 if (k .eq. 1) then ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rf(k)/atm_po)** $atm_kappa) do j = jmin, jmax do i = imin, imax ddrp = ddrp1 if (hfacc(i,j,k,bi,bj) .eq. 0.) then ddrp = 0. endif adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)-adphihyd(i,j, $k)*ddrp adphihyd(i,j,k) = 0.d0 end do end do else ddrp1 = atm_cp*((rc(k)/atm_po)**atm_kappa-(rc(k-1)/atm_po)** $atm_kappa)*0.5 ddrm1 = ddrp1 do j = jmin, jmax do i = imin, imax ddrp = ddrp1 ddrm = ddrm1 if (hfacc(i,j,k,bi,bj) .eq. 0.) then ddrp = 0. endif if (hfacc(i,j,k-1,bi,bj) .eq. 0.) then ddrm = 0. endif adtheta(i,j,k-1,bi,bj) = adtheta(i,j,k-1,bi,bj)- $adphihyd(i,j,k)*ddrm adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)-adphihyd(i,j, $k)*ddrp adphihyd(i,j,k-1) = adphihyd(i,j,k-1)+adphihyd(i,j,k) adphihyd(i,j,k) = 0.d0 end do end do endif endif end subroutine adconvect( bi, bj, imin, imax, jmin, jmax, k, rhokm1, $rhokp1, mytime, adrhokm1, adrhokp1 ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) double precision adrhokp1(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k double precision mytime double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) double precision rhokp1(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define local variables C============================================== double precision adsmix(1-olx:snx+olx,1-oly:sny+oly) double precision adtmix(1-olx:snx+olx,1-oly:sny+oly) double precision dsum(1-olx:snx+olx,1-oly:sny+oly) integer i integer ip1 integer ip2 integer j C============================================== C define external procedures and functions C============================================== logical different_multiple external different_multiple C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adsmix(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adtmix(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (different_multiple(cadjfreq,mytime,mytime-deltatclock)) then do j = jmin, jmax do i = imin, imax dsum(i,j) = hfacc(i,j,k-1,bi,bj)*drf(k-1)+hfacc(i,j,k,bi,bj) $*drf(k) end do end do do j = jmin, jmax do i = imin, imax if (hfacc(i,j,k,bi,bj) .gt. 0. .and. rhokm1(i,j) .gt. $rhokp1(i,j)) then adsmix(i,j) = adsmix(i,j)+adsalt(i,j,k,bi,bj)/dsum(i,j) adsalt(i,j,k,bi,bj) = 0.d0 adsmix(i,j) = adsmix(i,j)+adsalt(i,j,k-1,bi,bj)/dsum(i,j) adsalt(i,j,k-1,bi,bj) = 0.d0 adtmix(i,j) = adtmix(i,j)+adtheta(i,j,k,bi,bj)/dsum(i,j) adtheta(i,j,k,bi,bj) = 0.d0 adtmix(i,j) = adtmix(i,j)+adtheta(i,j,k-1,bi,bj)/dsum(i,j) adtheta(i,j,k-1,bi,bj) = 0.d0 endif end do end do do j = jmin, jmax do i = imin, imax adsalt(i,j,k-1,bi,bj) = adsalt(i,j,k-1,bi,bj)+adsmix(i,j)* $hfacc(i,j,k-1,bi,bj)*drf(k-1) adsalt(i,j,k,bi,bj) = adsalt(i,j,k,bi,bj)+adsmix(i,j)* $hfacc(i,j,k,bi,bj)*drf(k) adsmix(i,j) = 0.d0 adtheta(i,j,k-1,bi,bj) = adtheta(i,j,k-1,bi,bj)+adtmix(i,j)* $hfacc(i,j,k-1,bi,bj)*drf(k-1) adtheta(i,j,k,bi,bj) = adtheta(i,j,k,bi,bj)+adtmix(i,j)* $hfacc(i,j,k,bi,bj)*drf(k) adtmix(i,j) = 0.d0 end do end do endif end subroutine mdconvective_adjustment( bi, bj, imin, imax, jmin, $jmax, mytime, myiter, mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /cadrhok/ rhokh real*4 rhokh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadrhokm1/ rhokm1h real*4 rhokm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadsalt/ salth real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadsalu/ salti real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadtheta/ thetah real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetb/ thetai real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /parm_eos_lin/ talpha, sbeta, eostype character*(6) eostype double precision sbeta double precision talpha common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, $ikey_daily_2, iloop_daily integer ikey_daily_1 integer ikey_daily_2 integer ikey_dynamics integer ikey_yearly integer iloop_daily common /tamckeys/ key, ikey, idkey integer idkey integer ikey integer key C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer myiter integer mythid double precision mytime C============================================== C define local variables C============================================== integer act1 integer act2 integer act3 integer act4 double precision convectcount(1-olx:snx+olx,1-oly:sny+oly,nr) integer help_h integer help_i integer help_j integer ip1 integer ip2 integer k integer kkey integer max1 integer max2 integer max3 double precision rhok(1-olx:snx+olx,1-oly:sny+oly) double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define external procedures and functions C============================================== logical different_multiple external different_multiple C********************************************** C executable statements of routine C********************************************** if (different_multiple(cadjfreq,mytime,mytime-deltatclock)) then act1 = bi-mybxlo(mythid) max1 = mybxhi(mythid)-mybxlo(mythid)+1 act2 = bj-mybylo(mythid) max2 = mybyhi(mythid)-mybylo(mythid)+1 act3 = mythid-1 max3 = ntx*nty act4 = ikey_dynamics-1 ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 do k = 2, nr kkey = (ikey-1)*nr+k do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) thetai(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly,k-1, $bi,bj) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salti(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k-1,bi, $bj) end do end do help_h = k-1 help_i = k-1 call find_rho( bi,bj,imin,imax,jmin,jmax,help_h,help_i, $eostype,theta,salt,rhokm1,mythid ) do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) thetah(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly,k,bi, $bj) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salth(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k,bi, $bj) end do end do help_j = k-1 call find_rho( bi,bj,imin,imax,jmin,jmax,k,help_j,eostype, $theta,salt,rhok,mythid ) do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) rhokm1h(ip1,ip2,kkey) = rhokm1(ip1-1+1-olx,ip2-1+1-oly) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) rhokh(ip1,ip2,kkey) = rhok(ip1-1+1-olx,ip2-1+1-oly) end do end do call convect( bi,bj,imin,imax,jmin,jmax,k,rhokm1,rhok, $convectcount,mytime,myiter,mythid ) end do endif end subroutine adconvective_adjustment( bi, bj, imin, imax, jmin, $jmax, mytime, mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /cadrhok/ rhokh real*4 rhokh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadrhokm1/ rhokm1h real*4 rhokm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadsalt/ salth real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadsalu/ salti real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadtheta/ thetah real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetb/ thetai real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /parm_eos_lin/ talpha, sbeta, eostype character*(6) eostype double precision sbeta double precision talpha common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, $ikey_daily_2, iloop_daily integer ikey_daily_1 integer ikey_daily_2 integer ikey_dynamics integer ikey_yearly integer iloop_daily common /tamckeys/ key, ikey, idkey integer idkey integer ikey integer key C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer mythid double precision mytime C============================================== C define local variables C============================================== integer act1 integer act2 integer act3 integer act4 double precision adrhok(1-olx:snx+olx,1-oly:sny+oly) double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) integer help_h integer help_i integer help_j integer ip1 integer ip2 integer k integer kkey integer max1 integer max2 integer max3 double precision rhok(1-olx:snx+olx,1-oly:sny+oly) double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define external procedures and functions C============================================== logical different_multiple external different_multiple C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adrhok(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adrhokm1(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (different_multiple(cadjfreq,mytime,mytime-deltatclock)) then act1 = bi-mybxlo(mythid) max1 = mybxhi(mythid)-mybxlo(mythid)+1 act2 = bj-mybylo(mythid) max2 = mybyhi(mythid)-mybylo(mythid)+1 act3 = mythid-1 max3 = ntx*nty act4 = ikey_dynamics-1 ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 do k = nr, 2, -1 kkey = (ikey-1)*nr+k help_h = k-1 help_i = k-1 do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) theta(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = thetah(ip1,ip2, $kkey) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = salth(ip1,ip2, $kkey) end do end do help_j = k-1 do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) rhokm1(ip1-1+1-olx,ip2-1+1-oly) = rhokm1h(ip1,ip2,kkey) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) rhok(ip1-1+1-olx,ip2-1+1-oly) = rhokh(ip1,ip2,kkey) end do end do call adconvect( bi,bj,imin,imax,jmin,jmax,k,rhokm1,rhok, $mytime,adrhokm1,adrhok ) call adfind_rho( bi,bj,imin,imax,jmin,jmax,k,help_j,eostype, $theta,salt,adtheta,adsalt,adrhok ) do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) theta(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = thetai(ip1,ip2, $kkey) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salt(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = salti(ip1,ip2, $kkey) end do end do call adfind_rho( bi,bj,imin,imax,jmin,jmax,help_h,help_i, $eostype,theta,salt,adtheta,adsalt,adrhokm1 ) end do endif end subroutine adcorrection_step( bi, bj, imin, imax, jmin, jmax, k, $adphisurfx, adphisurfy ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k C============================================== C define local variables C============================================== double precision hxfac double precision hyfac integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- hxfac = pffacmom hyfac = pffacmom do j = jmin, jmax do i = imin, imax adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj) adgvnm1(i,j,k,bi,bj) = 0.d0 adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)+advvel(i,j,k,bi, $bj)*masks(i,j,k,bi,bj) adphisurfy(i,j) = adphisurfy(i,j)-advvel(i,j,k,bi,bj)* $deltatmom*hyfac*implicsurfpress*masks(i,j,k,bi,bj) advvel(i,j,k,bi,bj) = 0.d0 end do end do do j = jmin, jmax do i = imin, imax adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj) adgunm1(i,j,k,bi,bj) = 0.d0 adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)+aduvel(i,j,k,bi, $bj)*maskw(i,j,k,bi,bj) adphisurfx(i,j) = adphisurfx(i,j)-aduvel(i,j,k,bi,bj)* $deltatmom*hxfac*implicsurfpress*maskw(i,j,k,bi,bj) aduvel(i,j,k,bi,bj) = 0.d0 end do end do end subroutine adcost_final( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) C============================================== C define common blocks C============================================== common /adcost_r/ adfc, adobjf_test double precision adfc double precision adobjf_test(nsx,nsy) common /cost_aux_r/ mult_hq, mult_hs, mult_tauu, mult_tauv, $mult_hmean, mult_h, mult_temp, mult_salt, mult_sst, mult_atl, $mult_ctdt, mult_ctds, mult_test double precision mult_atl double precision mult_ctds double precision mult_ctdt double precision mult_h double precision mult_hmean double precision mult_hq double precision mult_hs double precision mult_salt double precision mult_sst double precision mult_tauu double precision mult_tauv double precision mult_temp double precision mult_test common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer bi integer bj integer ithi integer itlo integer jthi integer jtlo C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- jtlo = mybylo(mythid) jthi = mybyhi(mythid) itlo = mybxlo(mythid) ithi = mybxhi(mythid) call global_adsum_r8( mythid,adfc ) do bj = jtlo, jthi do bi = itlo, ithi adobjf_test(bi,bj) = adobjf_test(bi,bj)+adfc*mult_test end do end do end subroutine adcost_test( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /adcost_r/ adfc, adobjf_test double precision adfc double precision adobjf_test(nsx,nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /cost_test_i/ ilocout, jlocout, klocout integer ilocout integer jlocout integer klocout common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer bi integer bj integer i integer ig integer ithi integer itlo integer j integer jg integer jthi integer jtlo C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- jtlo = mybylo(mythid) jthi = mybyhi(mythid) itlo = mybxlo(mythid) ithi = mybxhi(mythid) ilocout = 6 jlocout = 35 klocout = 1 do bj = jtlo, jthi do bi = itlo, ithi do j = 1, sny jg = myygloballo-1+(bj-1)*sny+j do i = 1, snx ig = myxgloballo-1+(bi-1)*snx+i if (ig .eq. ilocout .and. jg .eq. jlocout) then adtheta(i,j,klocout,bi,bj) = adtheta(i,j,klocout,bi,bj)+ $adobjf_test(bi,bj) adobjf_test(bi,bj) = 0.d0 endif end do end do end do end do end subroutine adctrl_map_forcing( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_len_fnam parameter ( max_len_fnam = 512 ) integer max_no_threads parameter ( max_no_threads = 32 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer optimcycle parameter ( optimcycle = 0 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /adcontrolvars_r/ adtmpfld2d, adtmpfld3d double precision adtmpfld2d(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adtmpfld3d(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) common /adffields/ adfu, adfv, adqnet, adempmr double precision adempmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adfu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adfv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adqnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /controlfiles_c/ xx_theta_file, xx_salt_file, xx_tauu_file, $ xx_tauv_file, xx_sflux_file, xx_hflux_file, xx_sss_file, $xx_sst_file, xx_diffkr_file, xx_kapgm_file character*(max_len_fnam) xx_diffkr_file character*(max_len_fnam) xx_hflux_file character*(max_len_fnam) xx_kapgm_file character*(max_len_fnam) xx_salt_file character*(max_len_fnam) xx_sflux_file character*(max_len_fnam) xx_sss_file character*(max_len_fnam) xx_sst_file character*(max_len_fnam) xx_tauu_file character*(max_len_fnam) xx_tauv_file character*(max_len_fnam) xx_theta_file common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer bi integer bj logical doglobalread character*(80) fnamehflux character*(80) fnamesflux character*(80) fnametauu character*(80) fnametauv integer i integer il integer imax integer imin integer ithi integer itlo integer j integer jmax integer jmin integer jthi integer jtlo logical ladinit C============================================== C define external procedures and functions C============================================== integer ilnblnk external ilnblnk C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- jtlo = mybylo(mythid) jthi = mybyhi(mythid) itlo = mybxlo(mythid) ithi = mybxhi(mythid) jmin = 1-oly jmax = sny+oly imin = 1-olx imax = snx+olx doglobalread = .false. ladinit = .false. il = ilnblnk(xx_tauu_file) write(fnametauu(1:80),'(2a,i10.10)') xx_tauu_file(1:il),'.', $optimcycle il = ilnblnk(xx_tauv_file) write(fnametauv(1:80),'(2a,i10.10)') xx_tauv_file(1:il),'.', $optimcycle il = ilnblnk(xx_sflux_file) write(fnamesflux(1:80),'(2a,i10.10)') xx_sflux_file(1:il),'.', $optimcycle il = ilnblnk(xx_hflux_file) write(fnamehflux(1:80),'(2a,i10.10)') xx_hflux_file(1:il),'.', $optimcycle do bj = jtlo, jthi do bi = itlo, ithi do j = jmin, jmax do i = imin, imax adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adqnet(i,j, $bi,bj) end do end do end do end do call adactive_read_xy( fnamehflux,1,doglobalread,ladinit, $optimcycle,mythid,adtmpfld2d ) do bj = jtlo, jthi do bi = itlo, ithi do j = jmin, jmax do i = imin, imax adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adempmr(i,j, $bi,bj) end do end do end do end do call adactive_read_xy( fnamesflux,1,doglobalread,ladinit, $optimcycle,mythid,adtmpfld2d ) do bj = jtlo, jthi do bi = itlo, ithi do j = jmin, jmax do i = imin, imax adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adfv(i,j,bi, $bj) end do end do end do end do call adactive_read_xy( fnametauv,1,doglobalread,ladinit, $optimcycle,mythid,adtmpfld2d ) do bj = jtlo, jthi do bi = itlo, ithi do j = jmin, jmax do i = imin, imax adtmpfld2d(i,j,bi,bj) = adtmpfld2d(i,j,bi,bj)+adfu(i,j,bi, $bj) end do end do end do end do call adactive_read_xy( fnametauu,1,doglobalread,ladinit, $optimcycle,mythid,adtmpfld2d ) end subroutine adctrl_map_ini( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_len_fnam parameter ( max_len_fnam = 512 ) integer max_no_threads parameter ( max_no_threads = 32 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer optimcycle parameter ( optimcycle = 0 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /adcontrolvars_r/ adtmpfld2d, adtmpfld3d double precision adtmpfld2d(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adtmpfld3d(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /controlfiles_c/ xx_theta_file, xx_salt_file, xx_tauu_file, $ xx_tauv_file, xx_sflux_file, xx_hflux_file, xx_sss_file, $xx_sst_file, xx_diffkr_file, xx_kapgm_file character*(max_len_fnam) xx_diffkr_file character*(max_len_fnam) xx_hflux_file character*(max_len_fnam) xx_kapgm_file character*(max_len_fnam) xx_salt_file character*(max_len_fnam) xx_sflux_file character*(max_len_fnam) xx_sss_file character*(max_len_fnam) xx_sst_file character*(max_len_fnam) xx_tauu_file character*(max_len_fnam) xx_tauv_file character*(max_len_fnam) xx_theta_file common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer bi integer bj logical doglobalread logical equal double precision fac character*(80) fnamesalt character*(80) fnametheta integer i integer il integer imax integer imin integer ithi integer itlo integer j integer jmax integer jmin integer jthi integer jtlo integer k logical ladinit C============================================== C define external procedures and functions C============================================== integer ilnblnk external ilnblnk C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- jtlo = mybylo(mythid) jthi = mybyhi(mythid) itlo = mybxlo(mythid) ithi = mybxhi(mythid) jmin = 1-oly jmax = sny+oly imin = 1-olx imax = snx+olx doglobalread = .false. ladinit = .false. equal = .true. if (equal) then fac = 1.d0 else fac = 0.d0 endif il = ilnblnk(xx_theta_file) write(fnametheta(1:80),'(2a,i10.10)') xx_theta_file(1:il),'.', $optimcycle il = ilnblnk(xx_salt_file) write(fnamesalt(1:80),'(2a,i10.10)') xx_salt_file(1:il),'.', $optimcycle call adexch_xyz_r8( mythid,adgsnm1 ) call adexch_xyz_r8( mythid,adsalt ) call adexch_xyz_r8( mythid,adgtnm1 ) call adexch_xyz_r8( mythid,adtheta ) do bj = jtlo, jthi do bi = itlo, ithi do k = 1, nr do j = jmin, jmax do i = imin, imax adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ $adgsnm1(i,j,k,bi,bj)*fac adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ $adsalt(i,j,k,bi,bj)*fac end do end do end do end do end do call adactive_read_xyz( fnamesalt,1,doglobalread,ladinit, $optimcycle,mythid,adtmpfld3d ) do bj = jtlo, jthi do bi = itlo, ithi do k = 1, nr do j = jmin, jmax do i = imin, imax adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ $adgtnm1(i,j,k,bi,bj)*fac adtmpfld3d(i,j,k,bi,bj) = adtmpfld3d(i,j,k,bi,bj)+ $adtheta(i,j,k,bi,bj)*fac end do end do end do end do end do call adactive_read_xyz( fnametheta,1,doglobalread,ladinit, $optimcycle,mythid,adtmpfld3d ) end subroutine adcycle_tracer( bi, bj, imin, imax, jmin, jmax, k, $adtracer, adgtracer, adgtrnm1 ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== C============================================== C define arguments C============================================== double precision adgtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtrnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k C============================================== C define local variables C============================================== integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do j = jmin, jmax do i = imin, imax adgtracer(i,j,k,bi,bj) = adgtracer(i,j,k,bi,bj)+adgtrnm1(i,j, $k,bi,bj) adgtrnm1(i,j,k,bi,bj) = 0.d0 adgtrnm1(i,j,k,bi,bj) = adgtrnm1(i,j,k,bi,bj)+adtracer(i,j,k, $bi,bj) adtracer(i,j,k,bi,bj) = 0.d0 end do end do end subroutine addo_fields_blocking_exchanges( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, $adgucd, adgvcd double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) C============================================== C define arguments C============================================== integer mythid C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- call adexch_xyz_r8( mythid,advveld ) call adexch_xyz_r8( mythid,aduveld ) call adexch_xyz_r8( mythid,adsalt ) call adexch_xyz_r8( mythid,adtheta ) call adexch_xyz_r8( mythid,advvel ) call adexch_xyz_r8( mythid,aduvel ) end subroutine mddynamics( mytime, myiter, mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /cadgtnm1/ gtnm1h real*4 gtnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadkappars/ kapparsh real*4 kapparsh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadkappart/ kapparth real*4 kapparth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadkapparu/ kapparsi real*4 kapparsi(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadkapparv/ kapparti real*4 kapparti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadsalw/ salth real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadsalx/ salti real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadsaly/ saltj real*4 saltj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetd/ thetah real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadthete/ thetai real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetf/ thetaj real*4 thetaj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /caduvel/ uvelh real*4 uvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadvvel/ vvelh real*4 vvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadwvel/ wvelh real*4 wvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /dynvars_cd/ uveld, vveld, etanm1, unm1, vnm1, gucd, gvcd double precision etanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision unm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_eos_lin/ talpha, sbeta, eostype character*(6) eostype double precision sbeta double precision talpha common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco logical useaim logical useecco logical usegmredi logical usekpp logical useobcs common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, $ikey_daily_2, iloop_daily integer ikey_daily_1 integer ikey_daily_2 integer ikey_dynamics integer ikey_yearly integer iloop_daily common /tamckeys/ key, ikey, idkey integer idkey integer ikey integer key C============================================== C define arguments C============================================== integer myiter integer mythid double precision mytime C============================================== C define local variables C============================================== integer act1 integer act2 integer act3 integer act4 integer bi integer bj double precision convectcount(1-olx:snx+olx,1-oly:sny+oly,nr) double precision fvers(1-olx:snx+olx,1-oly:sny+oly,2) double precision fvert(1-olx:snx+olx,1-oly:sny+oly,2) double precision fveru(1-olx:snx+olx,1-oly:sny+oly,2) double precision fverv(1-olx:snx+olx,1-oly:sny+oly,2) integer help_h integer i integer imax integer imin integer ip1 integer ip2 integer ip3 integer j integer jmax integer jmin integer k double precision kappars(1-olx:snx+olx,1-oly:sny+oly,nr) double precision kappart(1-olx:snx+olx,1-oly:sny+oly,nr) double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) integer kdown integer kkey integer km1 integer kup double precision maskc(1-olx:snx+olx,1-oly:sny+oly) double precision maskup(1-olx:snx+olx,1-oly:sny+oly) integer max1 integer max2 integer max3 double precision phihyd(1-olx:snx+olx,1-oly:sny+oly,nr) double precision phisurfx(1-olx:snx+olx,1-oly:sny+oly) double precision phisurfy(1-olx:snx+olx,1-oly:sny+oly) double precision rhok(1-olx:snx+olx,1-oly:sny+oly) double precision rhokm1(1-olx:snx+olx,1-oly:sny+oly) double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) double precision utrans(1-olx:snx+olx,1-oly:sny+oly) double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) double precision xa(1-olx:snx+olx,1-oly:sny+oly) double precision ya(1-olx:snx+olx,1-oly:sny+oly) C********************************************** C executable statements of routine C********************************************** do j = 1-oly, sny+oly do i = 1-olx, snx+olx do k = 1, nr phihyd(i,j,k) = 0.d0 end do rhokm1(i,j) = 0.d0 rhok(i,j) = 0.d0 phisurfx(i,j) = 0.d0 phisurfy(i,j) = 0.d0 end do end do do bj = mybylo(mythid), mybyhi(mythid) do bi = mybxlo(mythid), mybxhi(mythid) act1 = bi-mybxlo(mythid) max1 = mybxhi(mythid)-mybxlo(mythid)+1 act2 = bj-mybylo(mythid) max2 = mybyhi(mythid)-mybylo(mythid)+1 act3 = mythid-1 max3 = ntx*nty act4 = ikey_dynamics-1 ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 do j = 1-oly, sny+oly do i = 1-olx, snx+olx fvert(i,j,1) = 0.d0 fvert(i,j,2) = 0.d0 fvers(i,j,1) = 0.d0 fvers(i,j,2) = 0.d0 fveru(i,j,1) = 0.d0 fveru(i,j,2) = 0.d0 fverv(i,j,1) = 0.d0 fverv(i,j,2) = 0.d0 end do end do do k = 1, nr do j = 1-oly, sny+oly do i = 1-olx, snx+olx kappart(i,j,k) = 0.d0 kappars(i,j,k) = 0.d0 end do end do end do imin = 1-olx+1 imax = snx+olx jmin = 1-oly+1 jmax = sny+oly do k = nr, 1, -1 kkey = (ikey-1)*nr+k call integrate_for_w( bi,bj,k,uvel,vvel,wvel,mythid ) if (usegmredi .or. k .gt. 1 .and. ivdc_kappa .ne. 0.) then do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) thetaj(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1-oly, $k,bi,bj) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) saltj(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly,k, $bi,bj) end do end do call find_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype, $theta,salt,rhok,mythid ) if (k .gt. 1) then do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) thetai(ip1,ip2,kkey) = theta(ip1-1+1-olx,ip2-1+1- $oly,k-1,bi,bj) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salti(ip1,ip2,kkey) = salt(ip1-1+1-olx,ip2-1+1-oly, $k-1,bi,bj) end do end do help_h = k-1 call find_rho( bi,bj,imin,imax,jmin,jmax,help_h,k, $eostype,theta,salt,rhokm1,mythid ) endif endif if (k .gt. 1 .and. ivdc_kappa .ne. 0.) then call calc_ivdc( bi,bj,imin,imax,jmin,jmax,k,rhokm1,rhok, $convectcount,kappart,kappars,mytime,myiter,mythid ) endif end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) wvelh(ip1,ip2,ip3,ikey) = wvel(ip1-1+1-olx,ip2-1+1-oly, $ip3,bi,bj) end do end do end do call external_forcing_surf( bi,bj,imin,imax,jmin,jmax,mythid ) do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kapparti(ip1,ip2,ip3,ikey) = kappart(ip1-1+1-olx,ip2-1+ $1-oly,ip3) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kapparsi(ip1,ip2,ip3,ikey) = kappars(ip1-1+1-olx,ip2-1+ $1-oly,ip3) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) thetah(ip1,ip2,ip3,ikey) = theta(ip1-1+1-olx,ip2-1+1- $oly,ip3,bi,bj) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salth(ip1,ip2,ip3,ikey) = salt(ip1-1+1-olx,ip2-1+1-oly, $ip3,bi,bj) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) uvelh(ip1,ip2,ip3,ikey) = uvel(ip1-1+1-olx,ip2-1+1-oly, $ip3,bi,bj) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) vvelh(ip1,ip2,ip3,ikey) = vvel(ip1-1+1-olx,ip2-1+1-oly, $ip3,bi,bj) end do end do end do do k = nr, 1, -1 kkey = (ikey-1)*nr+k km1 = max(1,k-1) kup = 1+mod(k+1,2) kdown = 1+mod(k,2) imin = 1-olx+2 imax = snx+olx-1 jmin = 1-oly+2 jmax = sny+oly-1 call calc_common_factors( bi,bj,imin,imax,jmin,jmax,k,km1, $kup,kdown,xa,ya,utrans,vtrans,rtrans,maskc,maskup,mythid ) do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kapparth(ip1,ip2,kkey) = kappart(ip1-1+1-olx,ip2-1+1- $oly,k) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kapparsh(ip1,ip2,kkey) = kappars(ip1-1+1-olx,ip2-1+1- $oly,k) end do end do call calc_diffusivity( bi,bj,imin,imax,jmin,jmax,k,maskc, $maskup,kappart,kappars,kapparu,kapparv,mythid ) if (tempstepping) then call calc_gt( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, $xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappart,fvert,mytime, $mythid ) call timestep_tracer( bi,bj,imin,imax,jmin,jmax,k,theta, $gt,gtnm1,myiter,mythid ) endif if (saltstepping) then call calc_gs( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, $xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappars,fvers,mytime, $mythid ) call timestep_tracer( bi,bj,imin,imax,jmin,jmax,k,salt,gs, $gsnm1,myiter,mythid ) endif if (allowfreezing) then do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) gtnm1h(ip1,ip2,kkey) = gtnm1(ip1-1+1-olx,ip2-1+1-oly, $k,bi,bj) end do end do call freeze( bi,bj,imin,imax,jmin,jmax,k,mythid ) endif end do if (implicitdiffusion) then if (tempstepping) then call impldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, $kappart,recip_hfacc,gtnm1,mythid ) endif if (saltstepping) then call impldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, $kappars,recip_hfacc,gsnm1,mythid ) endif endif imin = 1-olx+2 imax = snx+olx-1 jmin = 1-oly+2 jmax = sny+oly-1 if (implicsurfpress .ne. 1.) then call calc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,etan, $phisurfx,phisurfy,mythid ) endif do k = 1, nr km1 = max(1,k-1) kup = 1+mod(k+1,2) kdown = 1+mod(k,2) if (staggertimestep) then call mdcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,gtnm1, $gsnm1,phihyd,mythid ) else call mdcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,theta, $salt,phihyd,mythid ) endif if (momstepping) then call calc_mom_rhs( bi,bj,imin,imax,jmin,jmax,k,kup,kdown, $phihyd,kapparu,kapparv,fveru,fverv,mytime,mythid ) call timestep( bi,bj,imin,imax,jmin,jmax,k,phihyd, $phisurfx,phisurfy,myiter,mythid ) else do j = 1-oly, sny+oly do i = 1-olx, snx+olx gucd(i,j,k,bi,bj) = 0. gvcd(i,j,k,bi,bj) = 0. end do end do endif end do if (implicitviscosity .and. momstepping) then call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparu, $recip_hfacw,gunm1,mythid ) call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparv, $recip_hfacs,gvnm1,mythid ) call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparu, $recip_hfacw,vveld,mythid ) call impldiff( bi,bj,imin,imax,jmin,jmax,deltatmom,kapparv, $recip_hfacs,uveld,mythid ) endif end do end do end subroutine addynamics( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, $adgucd, adgvcd double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /cadgtnm1/ gtnm1h real*4 gtnm1h(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadkappars/ kapparsh real*4 kapparsh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadkappart/ kapparth real*4 kapparth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadkapparu/ kapparsi real*4 kapparsi(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadkapparv/ kapparti real*4 kapparti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadsalw/ salth real*4 salth(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadsalx/ salti real*4 salti(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadsaly/ saltj real*4 saltj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetd/ thetah real*4 thetah(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadthete/ thetai real*4 thetai(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /cadthetf/ thetaj real*4 thetaj(1+snx+olx-(1-olx),1+sny+oly-(1-oly),540) common /caduvel/ uvelh real*4 uvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadvvel/ vvelh real*4 vvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /cadwvel/ wvelh real*4 wvelh(1+snx+olx-(1-olx),1+sny+oly-(1-oly),nr,36) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_eos_lin/ talpha, sbeta, eostype character*(6) eostype double precision sbeta double precision talpha common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_packages/ usekpp, usegmredi, useobcs, useaim, useecco logical useaim logical useecco logical usegmredi logical usekpp logical useobcs common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, $ikey_daily_2, iloop_daily integer ikey_daily_1 integer ikey_daily_2 integer ikey_dynamics integer ikey_yearly integer iloop_daily common /tamckeys/ key, ikey, idkey integer idkey integer ikey integer key C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer act1 integer act2 integer act3 integer act4 double precision adfvers(1-olx:snx+olx,1-oly:sny+oly,2) double precision adfvert(1-olx:snx+olx,1-oly:sny+oly,2) double precision adfveru(1-olx:snx+olx,1-oly:sny+oly,2) double precision adfverv(1-olx:snx+olx,1-oly:sny+oly,2) double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) double precision adrhok(1-olx:snx+olx,1-oly:sny+oly) double precision adrhokm1(1-olx:snx+olx,1-oly:sny+oly) double precision adrtrans(1-olx:snx+olx,1-oly:sny+oly) double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer help_h integer i integer imax integer imin integer ip1 integer ip2 integer ip3 integer j integer jmax integer jmin integer k double precision kappars(1-olx:snx+olx,1-oly:sny+oly,nr) double precision kappart(1-olx:snx+olx,1-oly:sny+oly,nr) double precision kapparu(1-olx:snx+olx,1-oly:sny+oly,nr) double precision kapparv(1-olx:snx+olx,1-oly:sny+oly,nr) integer kdown integer kkey integer km1 integer kup double precision maskc(1-olx:snx+olx,1-oly:sny+oly) double precision maskup(1-olx:snx+olx,1-oly:sny+oly) integer max1 integer max2 integer max3 double precision rtrans(1-olx:snx+olx,1-oly:sny+oly) double precision utrans(1-olx:snx+olx,1-oly:sny+oly) double precision vtrans(1-olx:snx+olx,1-oly:sny+oly) double precision xa(1-olx:snx+olx,1-oly:sny+oly) double precision ya(1-olx:snx+olx,1-oly:sny+oly) C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip3 = 1, 2 do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfvers(ip1,ip2,ip3) = 0.d0 end do end do end do do ip3 = 1, 2 do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfvert(ip1,ip2,ip3) = 0.d0 end do end do end do do ip3 = 1, 2 do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfveru(ip1,ip2,ip3) = 0.d0 end do end do end do do ip3 = 1, 2 do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfverv(ip1,ip2,ip3) = 0.d0 end do end do end do do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adphihyd(ip1,ip2,ip3) = 0.d0 end do end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adphisurfx(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adphisurfy(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adrhok(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adrhokm1(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adrtrans(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adutrans(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advtrans(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do bj = mybylo(mythid), mybyhi(mythid) do bi = mybxlo(mythid), mybxhi(mythid) do ip3 = 1, 2 do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfvers(ip1,ip2,ip3) = 0.d0 end do end do end do do ip3 = 1, 2 do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfvert(ip1,ip2,ip3) = 0.d0 end do end do end do do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adphihyd(ip1,ip2,ip3) = 0.d0 end do end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adrtrans(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adutrans(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advtrans(ip1,ip2) = 0.d0 end do end do act1 = bi-mybxlo(mythid) max1 = mybxhi(mythid)-mybxlo(mythid)+1 act2 = bj-mybylo(mythid) max2 = mybyhi(mythid)-mybylo(mythid)+1 act3 = mythid-1 max3 = ntx*nty act4 = ikey_dynamics-1 ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 imin = 1-olx+1 imax = snx+olx jmin = 1-oly+1 jmax = sny+oly do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) wvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = wvelh(ip1,ip2, $ip3,ikey) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kappart(ip1-1+1-olx,ip2-1+1-oly,ip3) = kapparti(ip1,ip2, $ip3,ikey) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kappars(ip1-1+1-olx,ip2-1+1-oly,ip3) = kapparsi(ip1,ip2, $ip3,ikey) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) theta(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = thetah(ip1, $ip2,ip3,ikey) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salt(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = salth(ip1,ip2, $ip3,ikey) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) uvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = uvelh(ip1,ip2, $ip3,ikey) end do end do end do do ip3 = 1, nr do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) vvel(ip1-1+1-olx,ip2-1+1-oly,ip3,bi,bj) = vvelh(ip1,ip2, $ip3,ikey) end do end do end do do k = nr, 1, -1 imin = 1-olx+2 imax = snx+olx-1 jmin = 1-oly+2 jmax = sny+oly-1 call calc_common_factors( bi,bj,imin,imax,jmin,jmax,k,km1, $kup,kdown,xa,ya,utrans,vtrans,rtrans,maskc,maskup,mythid ) call calc_diffusivity( bi,bj,imin,imax,jmin,jmax,k,maskc, $maskup,kappart,kappars,kapparu,kapparv,mythid ) end do imin = 1-olx+2 imax = snx+olx-1 jmin = 1-oly+2 jmax = sny+oly-1 if (implicitviscosity .and. momstepping) then call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, $kapparv,recip_hfacs,aduveld ) call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, $kapparu,recip_hfacw,advveld ) call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, $kapparv,recip_hfacs,adgvnm1 ) call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltatmom, $kapparu,recip_hfacw,adgunm1 ) endif do k = nr, 1, -1 kup = 1+mod(k+1,2) kdown = 1+mod(k,2) if (momstepping) then call adtimestep( bi,bj,imin,imax,jmin,jmax,k,adphihyd, $adphisurfx,adphisurfy ) call adcalc_mom_rhs( bi,bj,imin,imax,jmin,jmax,k,kup, $kdown,kapparu,kapparv,adphihyd,adfveru,adfverv ) endif if (staggertimestep) then call adcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,mythid, $adgtnm1,adgsnm1,adphihyd ) else call adcalc_phi_hyd( bi,bj,imin,imax,jmin,jmax,k,mythid, $adtheta,adsalt,adphihyd ) endif end do if (implicsurfpress .ne. 1.) then call adcalc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,adetan, $adphisurfx,adphisurfy ) endif do k = nr, 1, -1 imin = 1-olx+2 imax = snx+olx-1 jmin = 1-oly+2 jmax = sny+oly-1 end do if (implicitdiffusion) then if (saltstepping) then call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, $kappars,recip_hfacc,adgsnm1 ) endif if (tempstepping) then call adimpldiff( bi,bj,imin,imax,jmin,jmax,deltattracer, $kappart,recip_hfacc,adgtnm1 ) endif endif ikey = act1+1+act2*max1+act3*max1*max2+act4*max1*max2*max3 do k = 1, nr kkey = (ikey-1)*nr+k km1 = max(1,k-1) kup = 1+mod(k+1,2) kdown = 1+mod(k,2) imin = 1-olx+2 imax = snx+olx-1 jmin = 1-oly+2 jmax = sny+oly-1 call calc_common_factors( bi,bj,imin,imax,jmin,jmax,k,km1, $kup,kdown,xa,ya,utrans,vtrans,rtrans,maskc,maskup,mythid ) do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kappart(ip1-1+1-olx,ip2-1+1-oly,k) = kapparth(ip1,ip2, $kkey) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) kappars(ip1-1+1-olx,ip2-1+1-oly,k) = kapparsh(ip1,ip2, $kkey) end do end do call calc_diffusivity( bi,bj,imin,imax,jmin,jmax,k,maskc, $maskup,kappart,kappars,kapparu,kapparv,mythid ) if (allowfreezing) then do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) gtnm1(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = gtnm1h(ip1, $ip2,kkey) end do end do call adfreeze( bi,bj,imin,imax,jmin,jmax,k ) endif if (saltstepping) then call adtimestep_tracer( bi,bj,imin,imax,jmin,jmax,k, $adsalt,adgs,adgsnm1 ) call adcalc_gs( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, $xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappars,adutrans,advtrans, $adrtrans,adfvers ) endif if (tempstepping) then call adtimestep_tracer( bi,bj,imin,imax,jmin,jmax,k, $adtheta,adgt,adgtnm1 ) call adcalc_gt( bi,bj,imin,imax,jmin,jmax,k,km1,kup,kdown, $xa,ya,utrans,vtrans,rtrans,maskup,maskc,kappart,adutrans,advtrans, $adrtrans,adfvert ) endif call adcalc_common_factors( bi,bj,imin,imax,jmin,jmax,k, $adutrans,advtrans,adrtrans ) end do imin = 1-olx+1 imax = snx+olx jmin = 1-oly+1 jmax = sny+oly call adexternal_forcing_surf( bi,bj,imin,imax,jmin,jmax ) do k = 1, nr kkey = (ikey-1)*nr+k if (usegmredi .or. k .gt. 1 .and. ivdc_kappa .ne. 0.) then if (k .gt. 1) then do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) theta(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = $thetai(ip1,ip2,kkey) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salt(ip1-1+1-olx,ip2-1+1-oly,k-1,bi,bj) = salti(ip1, $ip2,kkey) end do end do help_h = k-1 call adfind_rho( bi,bj,imin,imax,jmin,jmax,help_h,k, $eostype,theta,salt,adtheta,adsalt,adrhokm1 ) endif do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) theta(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = thetaj(ip1, $ip2,kkey) end do end do do ip2 = 1, 1+sny+oly-(1-oly) do ip1 = 1, 1+snx+olx-(1-olx) salt(ip1-1+1-olx,ip2-1+1-oly,k,bi,bj) = saltj(ip1,ip2, $kkey) end do end do call adfind_rho( bi,bj,imin,imax,jmin,jmax,k,k,eostype, $theta,salt,adtheta,adsalt,adrhok ) endif call adintegrate_for_w( bi,bj,k,aduvel,advvel,adwvel ) end do do j = 1-oly, sny+oly do i = 1-olx, snx+olx adfvers(i,j,2) = 0.d0 adfvers(i,j,1) = 0.d0 adfvert(i,j,2) = 0.d0 adfvert(i,j,1) = 0.d0 end do end do end do end do end subroutine adexternal_forcing_s( imin, imax, jmin, jmax, bi, bj, $klev, maskc ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /adtendency_forcing/ adsurfacetendencyu, $adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer klev double precision maskc(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define local variables C============================================== integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (klev .eq. 1) then do j = jmin, jmax do i = imin, imax adsurfacetendencys(i,j,bi,bj) = adsurfacetendencys(i,j,bi, $bj)+adgs(i,j,klev,bi,bj)*maskc(i,j) end do end do endif end subroutine adexternal_forcing_surf( bi, bj, imin, imax, jmin, $jmax ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /adffields/ adfu, adfv, adqnet, adempmr double precision adempmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adfu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adfv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adqnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /adtendency_forcing/ adsurfacetendencyu, $adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_a/ heatcapacity_cp, recip_cp, lamba_theta double precision heatcapacity_cp double precision lamba_theta double precision recip_cp common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin C============================================== C define local variables C============================================== integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do j = jmin, jmax do i = imin, imax adempmr(i,j,bi,bj) = adempmr(i,j,bi,bj)+35.* $adsurfacetendencys(i,j,bi,bj)*recip_drf(1) adsalt(i,j,1,bi,bj) = adsalt(i,j,1,bi,bj)- $adsurfacetendencys(i,j,bi,bj)*lambdasaltclimrelax adsurfacetendencys(i,j,bi,bj) = 0.d0 adqnet(i,j,bi,bj) = adqnet(i,j,bi,bj)-adsurfacetendencyt(i,j, $bi,bj)*recip_cp*recip_rhonil*recip_drf(1) adtheta(i,j,1,bi,bj) = adtheta(i,j,1,bi,bj)- $adsurfacetendencyt(i,j,bi,bj)*lambdathetaclimrelax adsurfacetendencyt(i,j,bi,bj) = 0.d0 adfv(i,j,bi,bj) = adfv(i,j,bi,bj)+adsurfacetendencyv(i,j,bi, $bj)*horivertratio*recip_rhonil*recip_drf(1) adsurfacetendencyv(i,j,bi,bj) = 0.d0 adfu(i,j,bi,bj) = adfu(i,j,bi,bj)+adsurfacetendencyu(i,j,bi, $bj)*horivertratio*recip_rhonil*recip_drf(1) adsurfacetendencyu(i,j,bi,bj) = 0.d0 end do end do end subroutine adexternal_forcing_t( imin, imax, jmin, jmax, bi, bj, $klev, maskc ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /adtendency_forcing/ adsurfacetendencyu, $adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer klev double precision maskc(1-olx:snx+olx,1-oly:sny+oly) C============================================== C define local variables C============================================== integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (klev .eq. 1) then do j = jmin, jmax do i = imin, imax adsurfacetendencyt(i,j,bi,bj) = adsurfacetendencyt(i,j,bi, $bj)+adgt(i,j,klev,bi,bj)*maskc(i,j) end do end do endif end subroutine adexternal_forcing_u( imin, imax, jmin, jmax, bi, bj, $klev ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /adtendency_forcing/ adsurfacetendencyu, $adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer klev C============================================== C define local variables C============================================== integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (klev .eq. 1) then do j = jmin, jmax do i = imin, imax adsurfacetendencyu(i,j,bi,bj) = adsurfacetendencyu(i,j,bi, $bj)+adgu(i,j,klev,bi,bj)*fofacmom*maskw(i,j,klev,bi,bj) end do end do endif end subroutine adexternal_forcing_v( imin, imax, jmin, jmax, bi, bj, $klev ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /adtendency_forcing/ adsurfacetendencyu, $adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer klev C============================================== C define local variables C============================================== integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (klev .eq. 1) then do j = jmin, jmax do i = imin, imax adsurfacetendencyv(i,j,bi,bj) = adsurfacetendencyv(i,j,bi, $bj)+adgv(i,j,klev,bi,bj)*fofacmom*masks(i,j,klev,bi,bj) end do end do endif end subroutine adfind_rho( bi, bj, imin, imax, jmin, jmax, k, kref, $eqn, tfld, sfld, adtfld, adsfld, adrholoc ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /parm_eos_lin/ talpha, sbeta, eostype character*(6) eostype double precision sbeta double precision talpha common /parm_eos_nl/ eosc, eossig0, eosreft, eosrefs double precision eosc(9,nr+1) double precision eosrefs(nr+1) double precision eosreft(nr+1) double precision eossig0(nr+1) common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adrholoc(1-olx:snx+olx,1-oly:sny+oly) double precision adsfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) integer bi integer bj character*(*) eqn integer imax integer imin integer jmax integer jmin integer k integer kref double precision sfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision tfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) C============================================== C define local variables C============================================== double precision addeltasig double precision adsp double precision adtp integer i integer j double precision refsalt double precision reftemp double precision sp double precision tp C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- addeltasig = 0.d0 adsp = 0.d0 adtp = 0.d0 C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (eqn .eq. 'LINEAR') then do j = jmin, jmax do i = imin, imax adsfld(i,j,k,bi,bj) = adsfld(i,j,k,bi,bj)+adrholoc(i,j)* $rhonil*sbeta adtfld(i,j,k,bi,bj) = adtfld(i,j,k,bi,bj)-adrholoc(i,j)* $rhonil*talpha adrholoc(i,j) = 0.d0 end do end do else if (eqn .eq. 'POLY3') then reftemp = eosreft(kref) refsalt = eosrefs(kref) do j = jmin, jmax addeltasig = 0.d0 adsp = 0.d0 adtp = 0.d0 do i = imin, imax addeltasig = 0.d0 adsp = 0.d0 adtp = 0.d0 tp = tfld(i,j,k,bi,bj)-reftemp sp = sfld(i,j,k,bi,bj)-refsalt addeltasig = addeltasig+adrholoc(i,j) adrholoc(i,j) = 0.d0 adsp = adsp+addeltasig*((eosc(9,kref)*sp+eosc(5,kref))*sp+ $eosc(2,kref)+(eosc(9,kref)*sp+eosc(5,kref)+eosc(9,kref)*sp)*sp+ $(eosc(7,kref)*tp+eosc(8,kref)*sp+eosc(4,kref)+eosc(8,kref)*sp)*tp) adtp = adtp+addeltasig*((eosc(6,kref)*tp+eosc(7,kref)*sp+ $eosc(3,kref))*tp+(eosc(8,kref)*sp+eosc(4,kref))*sp+eosc(1,kref)+ $(eosc(6,kref)*tp+eosc(7,kref)*sp+eosc(3,kref)+eosc(6,kref)*tp)*tp) addeltasig = 0.d0 adsfld(i,j,k,bi,bj) = adsfld(i,j,k,bi,bj)+adsp adsp = 0.d0 adtfld(i,j,k,bi,bj) = adtfld(i,j,k,bi,bj)+adtp adtp = 0.d0 end do end do endif do j = 1-oly, sny+oly do i = 1-olx, snx+olx adrholoc(i,j) = 0.d0 end do end do end subroutine adfreeze( bi, bj, imin, imax, jmin, jmax, k ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) C============================================== C define arguments C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer k C============================================== C define local variables C============================================== integer i integer j double precision tfreezing C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- tfreezing = -1.9 do j = jmin, jmax do i = imin, imax if (gtnm1(i,j,k,bi,bj) .lt. tfreezing) then adgtnm1(i,j,k,bi,bj) = 0.d0 endif end do end do end subroutine adimpldiff( bi, bj, imin, imax, jmin, jmax, deltatx, $kapparx, recip_hfac, adgxnm1 ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) C============================================== C define arguments C============================================== double precision adgxnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) integer bi integer bj double precision deltatx integer imax integer imin integer jmax integer jmin double precision kapparx(1-olx:snx+olx,1-oly:sny+oly,nr) double precision recip_hfac(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) C============================================== C define local variables C============================================== double precision a(1-olx:snx+olx,1-oly:sny+oly,nr) double precision adgynm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision b(1-olx:snx+olx,1-oly:sny+oly,nr) double precision bet(1-olx:snx+olx,1-oly:sny+oly,nr) double precision c(1-olx:snx+olx,1-oly:sny+oly,nr) double precision gam(1-olx:snx+olx,1-oly:sny+oly,nr) integer i integer ip1 integer ip2 integer ip3 integer ip4 integer ip5 integer j integer k C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgynm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do j = jmin, jmax do i = imin, imax a(i,j,1) = 0.d0 end do end do do k = 2, nr do j = jmin, jmax do i = imin, imax a(i,j,k) = -(deltatx*recip_hfac(i,j,k,bi,bj)*recip_drf(k)* $kapparx(i,j,k)*recip_drc(k)) end do end do end do do k = 1, nr-1 do j = jmin, jmax do i = imin, imax c(i,j,k) = -(deltatx*recip_hfac(i,j,k,bi,bj)*recip_drf(k)* $kapparx(i,j,k+1)*recip_drc(k+1)) if (recip_hfac(i,j,k+1,bi,bj) .eq. 0.) then c(i,j,k) = 0. endif end do end do end do do j = jmin, jmax do i = imin, imax c(i,j,nr) = 0.d0 end do end do do k = 1, nr do j = jmin, jmax do i = imin, imax b(i,j,k) = 1.d0-c(i,j,k)-a(i,j,k) end do end do end do do k = 1, nr do j = jmin, jmax do i = imin, imax bet(i,j,k) = 0.d0 gam(i,j,k) = 0.d0 end do end do end do if (nr .gt. 1) then do j = jmin, jmax do i = imin, imax if (b(i,j,1) .ne. 0.) then bet(i,j,1) = 1.d0/b(i,j,1) endif end do end do endif if (nr .gt. 2) then do k = 2, nr do j = jmin, jmax do i = imin, imax gam(i,j,k) = c(i,j,k-1)*bet(i,j,k-1) if (b(i,j,k)-a(i,j,k)*gam(i,j,k) .ne. 0.) then bet(i,j,k) = 1.d0/(b(i,j,k)-a(i,j,k)*gam(i,j,k)) endif end do end do end do endif do k = 1, nr do j = jmin, jmax do i = imin, imax adgynm1(i,j,k,bi,bj) = adgynm1(i,j,k,bi,bj)+adgxnm1(i,j,k, $bi,bj) adgxnm1(i,j,k,bi,bj) = 0.d0 end do end do end do do k = 1, nr-1 do j = jmin, jmax do i = imin, imax adgynm1(i,j,k+1,bi,bj) = adgynm1(i,j,k+1,bi,bj)-adgynm1(i,j, $k,bi,bj)*gam(i,j,k+1) end do end do end do do k = nr, 2, -1 do j = jmin, jmax do i = imin, imax adgxnm1(i,j,k,bi,bj) = adgxnm1(i,j,k,bi,bj)+adgynm1(i,j,k, $bi,bj)*bet(i,j,k) adgynm1(i,j,k-1,bi,bj) = adgynm1(i,j,k-1,bi,bj)-adgynm1(i,j, $k,bi,bj)*bet(i,j,k)*a(i,j,k) adgynm1(i,j,k,bi,bj) = 0.d0 end do end do end do do j = jmin, jmax do i = imin, imax adgxnm1(i,j,1,bi,bj) = adgxnm1(i,j,1,bi,bj)+adgynm1(i,j,1,bi, $bj)*bet(i,j,1) adgynm1(i,j,1,bi,bj) = 0.d0 end do end do end subroutine mdinitialise_varia( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /parm_i/ cg2dmaxiters, cg2dchkresfreq, cg3dmaxiters, $cg3dchkresfreq, niter0, ntimesteps, nenditer, numstepsperpickup, $writestateprec, nchecklev, writebinaryprec, readbinaryprec, nshap, $ zonal_filt_sinpow, zonal_filt_cospow integer cg2dchkresfreq integer cg2dmaxiters integer cg3dchkresfreq integer cg3dmaxiters integer nchecklev integer nenditer integer niter0 integer nshap integer ntimesteps integer numstepsperpickup integer readbinaryprec integer writebinaryprec integer writestateprec integer zonal_filt_cospow integer zonal_filt_sinpow common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin C********************************************** C executable statements of routine C********************************************** call barrier( mythid ) call ini_fields( mythid ) call barrier( mythid ) if (usepickupbeforec35) then if (starttime .ne. 0.) then call mdthe_correction_step( starttime,niter0,mythid ) endif endif if (starttime .eq. 0.) then do bj = mybylo(mythid), mybyhi(mythid) do bi = mybxlo(mythid), mybxhi(mythid) imin = 1-olx imax = snx+olx jmin = 1-oly jmax = sny+oly call convective_adjustment_ini( bi,bj,imin,imax,jmin,jmax, $starttime,niter0,mythid ) end do end do call barrier( mythid ) endif call packages_init_variables( mythid ) if (tavefreq .gt. 0.) then do bj = mybylo(mythid), mybyhi(mythid) bi = mybxhi(mythid) end do endif end subroutine adinitialise_varia( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_cd/ addynvars_cd1, addynvars_cd2, addynvars_cd3, $ addynvars_cd4, addynvars_cd5, addynvars_cd6, addynvars_cd7 double precision addynvars_cd1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_cd2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_cd3(1-olx:snx+olx,1-oly:sny+oly,nsx, $nsy) double precision addynvars_cd4(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_cd5(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_cd6(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_cd7(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) common /addynvars_r/ addynvars_r1, addynvars_r2, addynvars_r3, $addynvars_r4, addynvars_r5, addynvars_r6, addynvars_r7, $addynvars_r8, addynvars_r9, addynvars_r10, addynvars_r11, $addynvars_r12, addynvars_r13, addynvars_r14 double precision addynvars_r1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision addynvars_r10(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r11(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r12(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r13(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r14(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r2(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r3(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r4(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r5(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r6(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r7(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r8(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) double precision addynvars_r9(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer ip1 integer ip2 integer ip3 integer ip4 integer ip5 C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- call barrier( mythid ) call barrier( mythid ) if (starttime .eq. 0.) then call barrier( mythid ) endif call adpackages_init_variables( mythid ) if (starttime .eq. 0.) then call barrier( mythid ) endif if (usepickupbeforec35) then if (starttime .ne. 0.) then call adthe_correction_step( starttime,mythid ) endif endif call barrier( mythid ) do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_cd1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_cd2(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_cd3(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_cd4(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_cd5(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r1(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r10(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r11(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r12(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r13(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r14(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r2(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r3(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r4(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r5(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r6(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r7(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r8(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx addynvars_r9(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do call barrier( mythid ) end subroutine adintegrate_for_w( bi, bj, k, adufld, advfld, adwfld ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords C============================================== C define arguments C============================================== double precision adufld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwfld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) integer bi integer bj integer k C============================================== C define local variables C============================================== double precision adutrans(1-olx:snx+olx,1-oly:sny+oly) double precision advtrans(1-olx:snx+olx,1-oly:sny+oly) integer i integer ip1 integer ip2 integer j C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adutrans(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advtrans(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- if (k .eq. 1 .and. rigidlid) then do j = 1-oly, sny+oly-1 do i = 1-olx, snx+olx-1 adwfld(i,j,k,bi,bj) = 0.d0 end do end do else if (k .eq. nr) then do j = 1-oly, sny+oly-1 do i = 1-olx, snx+olx-1 adutrans(i+1,j) = adutrans(i+1,j)-adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) adutrans(i,j) = adutrans(i,j)+adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) advtrans(i,j+1) = advtrans(i,j+1)-adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) advtrans(i,j) = advtrans(i,j)+adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) adwfld(i,j,k,bi,bj) = 0.d0 end do end do else do j = 1-oly, sny+oly-1 do i = 1-olx, snx+olx-1 adutrans(i+1,j) = adutrans(i+1,j)-adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) adutrans(i,j) = adutrans(i,j)+adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) advtrans(i,j+1) = advtrans(i,j+1)-adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) advtrans(i,j) = advtrans(i,j)+adwfld(i,j,k,bi,bj)* $recip_ra(i,j,bi,bj) adwfld(i,j,k+1,bi,bj) = adwfld(i,j,k+1,bi,bj)+adwfld(i,j,k, $bi,bj) adwfld(i,j,k,bi,bj) = 0.d0 end do end do endif do j = 1-oly, sny+oly do i = 1-olx, snx+olx advfld(i,j,k,bi,bj) = advfld(i,j,k,bi,bj)+advtrans(i,j)*dxg(i, $j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) advtrans(i,j) = 0.d0 adufld(i,j,k,bi,bj) = adufld(i,j,k,bi,bj)+adutrans(i,j)*dyg(i, $j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) adutrans(i,j) = 0.d0 end do end do end subroutine adpackages_init_variables( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /adcost_r/ adcost_r1, adcost_r14 double precision adcost_r1 double precision adcost_r14(nsx,nsy) common /adffields/ adffields1, adffields2, adffields3, adffields4 double precision adffields1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adffields2(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adffields3(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adffields4(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== integer ip1 integer ip2 integer ip3 integer ip4 C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- call barrier( mythid ) do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adffields1(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adffields2(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adffields3(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adffields4(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do call barrier( mythid ) adcost_r1 = 0.d0 call barrier( mythid ) call adctrl_map_ini( mythid ) end subroutine adsolve_for_pressure( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, $adgucd, adgvcd double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /solve_barot/ bo_surf, recip_bo double precision bo_surf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_bo(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== double precision adcg2d_b(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adcg2d_x(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) integer bi integer bj integer i integer ip1 integer ip2 integer ip3 integer ip4 integer j integer k integer numiters double precision residual double precision tolerance double precision uf(1-olx:snx+olx,1-oly:sny+oly) double precision vf(1-olx:snx+olx,1-oly:sny+oly) C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adcg2d_b(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adcg2d_x(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- tolerance = cg2dtargetresidual do bj = mybylo(mythid), mybyhi(mythid) do bi = mybxlo(mythid), mybxhi(mythid) do j = 1-oly, sny+oly do i = 1-olx, snx+olx adcg2d_x(i,j,bi,bj) = adcg2d_x(i,j,bi,bj)+adetan(i,j,bi, $bj)*recip_bo(i,j,bi,bj) adetan(i,j,bi,bj) = 0.d0 end do end do end do end do call adexch_xy_r8( mythid,adcg2d_x ) call cg2d( adcg2d_x,adcg2d_b,tolerance,residual,numiters,mythid ) do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adcg2d_x(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do bj = mybylo(mythid), mybyhi(mythid) do bi = mybxlo(mythid), mybxhi(mythid) do j = 1, sny do i = 1, snx adetan(i,j,bi,bj) = adetan(i,j,bi,bj)-adcg2d_b(i,j,bi,bj)* $(freesurffac*ra(i,j,bi,bj)/deltatmom/deltatmom) end do end do end do end do do bj = mybyhi(mythid), mybylo(mythid), -1 do bi = mybxhi(mythid), mybxlo(mythid), -1 do k = 1, nr do j = 1, sny+1 do i = 1, snx+1 uf(i,j) = dyg(i,j,bi,bj)*drf(k)*hfacw(i,j,k,bi,bj) vf(i,j) = dxg(i,j,bi,bj)*drf(k)*hfacs(i,j,k,bi,bj) end do end do call adcalc_div_ghat( bi,bj,k,uf,vf,adcg2d_b ) end do end do end do do bj = mybylo(mythid), mybyhi(mythid) do bi = mybxlo(mythid), mybxhi(mythid) do j = 1-oly, sny+oly do i = 1-olx, snx+olx adetan(i,j,bi,bj) = adetan(i,j,bi,bj)+adcg2d_x(i,j,bi,bj)* $bo_surf(i,j,bi,bj) adcg2d_x(i,j,bi,bj) = 0.d0 adetan(i,j,bi,bj) = adetan(i,j,bi,bj)+adetanm1(i,j,bi,bj) adetanm1(i,j,bi,bj) = 0.d0 end do end do end do end do end subroutine mdthe_correction_step( mytime, myiter, mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords C============================================== C define arguments C============================================== integer myiter integer mythid double precision mytime C============================================== C define local variables C============================================== integer bi integer bj integer imax integer imin integer jmax integer jmin integer k double precision phisurfx(1-olx:snx+olx,1-oly:sny+oly) double precision phisurfy(1-olx:snx+olx,1-oly:sny+oly) C********************************************** C executable statements of routine C********************************************** do bj = mybylo(mythid), mybyhi(mythid) do bi = mybxlo(mythid), mybxhi(mythid) imin = 1-olx+1 imax = snx+olx jmin = 1-oly+1 jmax = sny+oly call calc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,etan, $phisurfx,phisurfy,mythid ) do k = 1, nr if (momstepping) then call correction_step( bi,bj,imin,imax,jmin,jmax,k, $phisurfx,phisurfy,mytime,mythid ) endif if (tempstepping) then call cycle_tracer( bi,bj,imin,imax,jmin,jmax,k,theta,gt, $gtnm1,mytime,mythid ) endif if (saltstepping) then call cycle_tracer( bi,bj,imin,imax,jmin,jmax,k,salt,gs, $gsnm1,mytime,mythid ) endif end do call mdconvective_adjustment( bi,bj,imin,imax,jmin,jmax, $mytime,myiter,mythid ) end do end do end subroutine adthe_correction_step( mytime, mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer max_no_threads parameter ( max_no_threads = 32 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /eeparams_i/ errormessageunit, standardmessageunit, $scrunit1, scrunit2, eedataunit, modeldataunit, numberofprocs, $pidio, myprocid, mypx, mypy, myxgloballo, myygloballo, nthreads, $mybxlo, mybxhi, mybylo, mybyhi, ntx, nty, ioerrorcount integer eedataunit integer errormessageunit integer ioerrorcount(max_no_threads) integer modeldataunit integer mybxhi(max_no_threads) integer mybxlo(max_no_threads) integer mybyhi(max_no_threads) integer mybylo(max_no_threads) integer myprocid integer mypx integer mypy integer myxgloballo integer myygloballo integer nthreads integer ntx integer nty integer numberofprocs integer pidio integer scrunit1 integer scrunit2 integer standardmessageunit common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords C============================================== C define arguments C============================================== integer mythid double precision mytime C============================================== C define local variables C============================================== double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer ip1 integer ip2 integer jmax integer jmin integer k C---------------------------------------------- C RESET LOCAL ADJOINT VARIABLES C---------------------------------------------- do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adphisurfx(ip1,ip2) = 0.d0 end do end do do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adphisurfy(ip1,ip2) = 0.d0 end do end do C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- do bj = mybyhi(mythid), mybylo(mythid), -1 do bi = mybxhi(mythid), mybxlo(mythid), -1 imin = 1-olx+1 imax = snx+olx jmin = 1-oly+1 jmax = sny+oly call adconvective_adjustment( bi,bj,imin,imax,jmin,jmax, $mytime,mythid ) do k = nr, 1, -1 if (saltstepping) then call adcycle_tracer( bi,bj,imin,imax,jmin,jmax,k,adsalt, $adgs,adgsnm1 ) endif if (tempstepping) then call adcycle_tracer( bi,bj,imin,imax,jmin,jmax,k,adtheta, $adgt,adgtnm1 ) endif if (momstepping) then call adcorrection_step( bi,bj,imin,imax,jmin,jmax,k, $adphisurfx,adphisurfy ) endif end do call adcalc_grad_phi_surf( bi,bj,imin,imax,jmin,jmax,adetan, $adphisurfx,adphisurfy ) end do end do end subroutine adthe_main_loop( mythid ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nchklev_1 parameter ( nchklev_1 = 36 ) integer nchklev_2 parameter ( nchklev_2 = 30 ) integer nchklev_3 parameter ( nchklev_3 = 60 ) integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /cost_r/ fc, objf_hflux, objf_sflux, objf_tauu, objf_tauv, $objf_hmean, objf_h, objf_temp, objf_salt, objf_sst, objf_atl, $objf_ctdt, objf_ctds, objf_test double precision fc double precision objf_atl(nsx,nsy) double precision objf_ctds(nsx,nsy) double precision objf_ctdt(nsx,nsy) double precision objf_h(nsx,nsy) double precision objf_hflux(nsx,nsy) double precision objf_hmean double precision objf_salt(nsx,nsy) double precision objf_sflux(nsx,nsy) double precision objf_sst(nsx,nsy) double precision objf_tauu(nsx,nsy) double precision objf_tauv(nsx,nsy) double precision objf_temp(nsx,nsy) double precision objf_test(nsx,nsy) common /dynvars_cd/ uveld, vveld, etanm1, unm1, vnm1, gucd, gvcd double precision etanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision unm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /dynvars_r/ etan, uvel, vvel, wvel, theta, salt, gu, gv, $gt, gs, gunm1, gvnm1, gtnm1, gsnm1 double precision etan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision gs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision gvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision salt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision theta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision uvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision vvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision wvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /parm_i/ cg2dmaxiters, cg2dchkresfreq, cg3dmaxiters, $cg3dchkresfreq, niter0, ntimesteps, nenditer, numstepsperpickup, $writestateprec, nchecklev, writebinaryprec, readbinaryprec, nshap, $ zonal_filt_sinpow, zonal_filt_cospow integer cg2dchkresfreq integer cg2dmaxiters integer cg3dchkresfreq integer cg3dmaxiters integer nchecklev integer nenditer integer niter0 integer nshap integer ntimesteps integer numstepsperpickup integer readbinaryprec integer writebinaryprec integer writestateprec integer zonal_filt_cospow integer zonal_filt_sinpow common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat common /tamc_keys_i/ ikey_dynamics, ikey_yearly, ikey_daily_1, $ikey_daily_2, iloop_daily integer ikey_daily_1 integer ikey_daily_2 integer ikey_dynamics integer ikey_yearly integer iloop_daily C============================================== C define arguments C============================================== integer mythid C============================================== C define local variables C============================================== double precision fch integer ilev_1 integer ilev_2 integer ilev_3 integer iloop integer max_lev2 integer max_lev3 integer myiter double precision mytime C---------------------------------------------- C RESET GLOBAL ADJOINT VARIABLES C---------------------------------------------- call adzero C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- C---------------------------------------------- C OPEN FILES OF TAPE: tapelev3 C---------------------------------------------- call adopen( 'tapelev3_1_the_main_loop_gsnm1',30,8,1,8,17940 ) call adopen( 'tapelev3_2_the_main_loop_gtnm1',30,8,2,8,17940 ) call adopen( 'tapelev3_3_the_main_loop_gunm1',30,8,3,8,17940 ) call adopen( 'tapelev3_4_the_main_loop_gvnm1',30,8,4,8,17940 ) call adopen( 'tapelev3_5_the_main_loop_theta',30,8,5,8,17940 ) call adopen( 'tapelev3_6_the_main_loop_salt',29,8,6,8,17940 ) call adopen( 'tapelev3_7_the_main_loop_uvel',29,8,7,8,17940 ) call adopen( 'tapelev3_8_the_main_loop_vvel',29,8,8,8,17940 ) call adopen( 'tapelev3_9_the_main_loop_wvel',29,8,9,8,17940 ) call adopen( 'tapelev3_10_the_main_loop_etan',30,8,10,8,1196 ) call adopen( 'tapelev3_11_the_main_loop_etanm1',32,8,11,8,1196 ) call adopen( 'tapelev3_12_the_main_loop_uveld',31,8,12,8,17940 ) call adopen( 'tapelev3_13_the_main_loop_vveld',31,8,13,8,17940 ) call adopen( 'tapelev3_14_the_main_loop_unm1',30,8,14,8,17940 ) call adopen( 'tapelev3_15_the_main_loop_vnm1',30,8,15,8,17940 ) C---------------------------------------------- C FUNCTION AND TAPE COMPUTATIONS C---------------------------------------------- ikey_dynamics = 1 call initialise_varia( mythid ) call ctrl_map_forcing( mythid ) call barrier( mythid ) max_lev3 = ntimesteps/(nchklev_1*nchklev_2)+1 max_lev2 = ntimesteps/nchklev_1+1 do ilev_3 = 1, nchklev_3 if (ilev_3 .le. max_lev3) then call adwrite( 'tapelev3_1_the_main_loop_gsnm1',30,8,1,gsnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_2_the_main_loop_gtnm1',30,8,2,gtnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_3_the_main_loop_gunm1',30,8,3,gunm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_4_the_main_loop_gvnm1',30,8,4,gvnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_5_the_main_loop_theta',30,8,5,theta,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_6_the_main_loop_salt',29,8,6,salt,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_7_the_main_loop_uvel',29,8,7,uvel,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_8_the_main_loop_vvel',29,8,8,vvel,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_9_the_main_loop_wvel',29,8,9,wvel,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_10_the_main_loop_etan',30,8,10,etan,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_11_the_main_loop_etanm1',32,8,11, $etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_12_the_main_loop_uveld',31,8,12,uveld, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_13_the_main_loop_vveld',31,8,13,vveld, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_14_the_main_loop_unm1',30,8,14,unm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adwrite( 'tapelev3_15_the_main_loop_vnm1',30,8,15,vnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) do ilev_2 = 1, nchklev_2 if (ilev_2 .le. max_lev2) then do ilev_1 = 1, nchklev_1 iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* $nchklev_1+ilev_1 if (iloop .le. ntimesteps) then myiter = niter0+iloop-1 mytime = starttime+float(iloop-1)*deltatclock ikey_dynamics = ilev_1 call dynamics( mytime,myiter,mythid ) call solve_for_pressure( mythid ) call dummy_in_stepping( mytime,myiter,mythid ) mytime = starttime+deltatclock*float(iloop) call the_correction_step( mytime,myiter,mythid ) call do_fields_blocking_exchanges( mythid ) endif end do endif end do endif end do call barrier( mythid ) call cost_test( mythid ) call cost_final( mythid ) C---------------------------------------------- C SAVE DEPENDEND VARIABLES C---------------------------------------------- fch = fc C---------------------------------------------- C ADJOINT COMPUTATIONS C---------------------------------------------- call barrier( mythid ) do ilev_3 = 1, nchklev_3 if (ilev_3 .le. max_lev3) then do ilev_2 = 1, nchklev_2 if (ilev_2 .le. max_lev2) then do ilev_1 = 1, nchklev_1 iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* $nchklev_1+ilev_1 if (iloop .le. ntimesteps) then myiter = niter0+iloop-1 mytime = starttime+float(iloop-1)*deltatclock call dummy_in_stepping( mytime,myiter,mythid ) endif end do endif end do endif end do call barrier( mythid ) call adcost_final( mythid ) call adcost_test( mythid ) call barrier( mythid ) do ilev_3 = nchklev_3, 1, -1 if (ilev_3 .le. max_lev3) then call adread( 'tapelev3_1_the_main_loop_gsnm1',30,8,1,gsnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_2_the_main_loop_gtnm1',30,8,2,gtnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_3_the_main_loop_gunm1',30,8,3,gunm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_4_the_main_loop_gvnm1',30,8,4,gvnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_5_the_main_loop_theta',30,8,5,theta,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_6_the_main_loop_salt',29,8,6,salt,8,(1+ $snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_7_the_main_loop_uvel',29,8,7,uvel,8,(1+ $snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_8_the_main_loop_vvel',29,8,8,vvel,8,(1+ $snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_9_the_main_loop_wvel',29,8,9,wvel,8,(1+ $snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_10_the_main_loop_etan',30,8,10,etan,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) call adread( 'tapelev3_11_the_main_loop_etanm1',32,8,11, $etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_3 ) call adread( 'tapelev3_12_the_main_loop_uveld',31,8,12,uveld, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_13_the_main_loop_vveld',31,8,13,vveld, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_14_the_main_loop_unm1',30,8,14,unm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) call adread( 'tapelev3_15_the_main_loop_vnm1',30,8,15,vnm1,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_3 ) C---------------------------------------------- C OPEN FILES OF TAPE: tapelev2 C---------------------------------------------- call adopen( 'tapelev2_1_the_main_loop_gsnm1',30,9,1,8,17940 ) call adopen( 'tapelev2_2_the_main_loop_gtnm1',30,9,2,8,17940 ) call adopen( 'tapelev2_3_the_main_loop_gunm1',30,9,3,8,17940 ) call adopen( 'tapelev2_4_the_main_loop_gvnm1',30,9,4,8,17940 ) call adopen( 'tapelev2_5_the_main_loop_theta',30,9,5,8,17940 ) call adopen( 'tapelev2_6_the_main_loop_salt',29,9,6,8,17940 ) call adopen( 'tapelev2_7_the_main_loop_uvel',29,9,7,8,17940 ) call adopen( 'tapelev2_8_the_main_loop_vvel',29,9,8,8,17940 ) call adopen( 'tapelev2_9_the_main_loop_wvel',29,9,9,8,17940 ) call adopen( 'tapelev2_10_the_main_loop_etan',30,9,10,8,1196 ) call adopen( 'tapelev2_11_the_main_loop_etanm1',32,9,11,8, $1196 ) call adopen( 'tapelev2_12_the_main_loop_uveld',31,9,12,8, $17940 ) call adopen( 'tapelev2_13_the_main_loop_vveld',31,9,13,8, $17940 ) call adopen( 'tapelev2_14_the_main_loop_unm1',30,9,14,8,17940 $) call adopen( 'tapelev2_15_the_main_loop_vnm1',30,9,15,8,17940 $) C---------------------------------------------- C TAPE COMPUTATIONS C---------------------------------------------- do ilev_2 = 1, nchklev_2-1 if (ilev_2 .le. max_lev2) then call adwrite( 'tapelev2_1_the_main_loop_gsnm1',30,9,1, $gsnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_2_the_main_loop_gtnm1',30,9,2, $gtnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_3_the_main_loop_gunm1',30,9,3, $gunm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_4_the_main_loop_gvnm1',30,9,4, $gvnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_5_the_main_loop_theta',30,9,5, $theta,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_6_the_main_loop_salt',29,9,6,salt, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_7_the_main_loop_uvel',29,9,7,uvel, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_8_the_main_loop_vvel',29,9,8,vvel, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_9_the_main_loop_wvel',29,9,9,wvel, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_10_the_main_loop_etan',30,9,10, $etan,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_11_the_main_loop_etanm1',32,9,11, $etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_12_the_main_loop_uveld',31,9,12, $uveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_13_the_main_loop_vveld',31,9,13, $vveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_14_the_main_loop_unm1',30,9,14, $unm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_15_the_main_loop_vnm1',30,9,15, $vnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) do ilev_1 = 1, nchklev_1 iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* $nchklev_1+ilev_1 if (iloop .le. ntimesteps) then myiter = niter0+iloop-1 mytime = starttime+float(iloop-1)*deltatclock ikey_dynamics = ilev_1 call dynamics( mytime,myiter,mythid ) call solve_for_pressure( mythid ) call dummy_in_stepping( mytime,myiter,mythid ) mytime = starttime+deltatclock*float(iloop) call the_correction_step( mytime,myiter,mythid ) call do_fields_blocking_exchanges( mythid ) endif end do endif end do ilev_2 = nchklev_2 if (ilev_2 .le. max_lev2) then call adwrite( 'tapelev2_1_the_main_loop_gsnm1',30,9,1,gsnm1, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_2_the_main_loop_gtnm1',30,9,2,gtnm1, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_3_the_main_loop_gunm1',30,9,3,gunm1, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_4_the_main_loop_gvnm1',30,9,4,gvnm1, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_5_the_main_loop_theta',30,9,5,theta, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_6_the_main_loop_salt',29,9,6,salt,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_7_the_main_loop_uvel',29,9,7,uvel,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_8_the_main_loop_vvel',29,9,8,vvel,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_9_the_main_loop_wvel',29,9,9,wvel,8, $(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_10_the_main_loop_etan',30,9,10,etan, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_11_the_main_loop_etanm1',32,9,11, $etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_12_the_main_loop_uveld',31,9,12, $uveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_13_the_main_loop_vveld',31,9,13, $vveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adwrite( 'tapelev2_14_the_main_loop_unm1',30,9,14,unm1, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adwrite( 'tapelev2_15_the_main_loop_vnm1',30,9,15,vnm1, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) do ilev_1 = 1, nchklev_1 iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* $nchklev_1+ilev_1 if (iloop .le. ntimesteps) then myiter = niter0+iloop-1 mytime = starttime+float(iloop-1)*deltatclock call dummy_in_stepping( mytime,myiter,mythid ) endif end do endif C---------------------------------------------- C ADJOINT COMPUTATIONS C---------------------------------------------- do ilev_2 = nchklev_2, 1, -1 if (ilev_2 .le. max_lev2) then call adread( 'tapelev2_1_the_main_loop_gsnm1',30,9,1, $gsnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adread( 'tapelev2_2_the_main_loop_gtnm1',30,9,2, $gtnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adread( 'tapelev2_3_the_main_loop_gunm1',30,9,3, $gunm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adread( 'tapelev2_4_the_main_loop_gvnm1',30,9,4, $gvnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adread( 'tapelev2_5_the_main_loop_theta',30,9,5, $theta,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adread( 'tapelev2_6_the_main_loop_salt',29,9,6,salt, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adread( 'tapelev2_7_the_main_loop_uvel',29,9,7,uvel, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adread( 'tapelev2_8_the_main_loop_vvel',29,9,8,vvel, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adread( 'tapelev2_9_the_main_loop_wvel',29,9,9,wvel, $8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adread( 'tapelev2_10_the_main_loop_etan',30,9,10, $etan,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) call adread( 'tapelev2_11_the_main_loop_etanm1',32,9,11, $etanm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nsx*nsy,ilev_2 ) call adread( 'tapelev2_12_the_main_loop_uveld',31,9,12, $uveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adread( 'tapelev2_13_the_main_loop_vveld',31,9,13, $vveld,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 $) call adread( 'tapelev2_14_the_main_loop_unm1',30,9,14, $unm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) call adread( 'tapelev2_15_the_main_loop_vnm1',30,9,15, $vnm1,8,(1+snx+olx-(1-olx))*(1+sny+oly-(1-oly))*nr*nsx*nsy,ilev_2 ) C---------------------------------------------- C TAPE COMPUTATIONS C---------------------------------------------- do ilev_1 = 1, nchklev_1 iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* $nchklev_1+ilev_1 if (iloop .le. ntimesteps) then myiter = niter0+iloop-1 mytime = starttime+float(iloop-1)*deltatclock ikey_dynamics = ilev_1 call mddynamics( mytime,myiter,mythid ) call solve_for_pressure( mythid ) call dummy_in_stepping( mytime,myiter,mythid ) mytime = starttime+deltatclock*float(iloop) call mdthe_correction_step( mytime,myiter,mythid ) call do_fields_blocking_exchanges( mythid ) endif end do C---------------------------------------------- C ADJOINT COMPUTATIONS C---------------------------------------------- do ilev_1 = nchklev_1, 1, -1 iloop = (ilev_3-1)*nchklev_2*nchklev_1+(ilev_2-1)* $nchklev_1+ilev_1 if (iloop .le. ntimesteps) then myiter = niter0+iloop-1 mytime = starttime+float(iloop-1)*deltatclock ikey_dynamics = ilev_1 call dummy_in_stepping( mytime,myiter,mythid ) mytime = starttime+deltatclock*float(iloop) call addo_fields_blocking_exchanges( mythid ) call adthe_correction_step( mytime,mythid ) mytime = starttime+float(iloop-1)*deltatclock call addummy_in_stepping( mytime,myiter,mythid ) call adsolve_for_pressure( mythid ) call addynamics( mythid ) endif end do endif end do C---------------------------------------------- C CLOSE FILES OF TAPE: tapelev2 C---------------------------------------------- call adclose( 'tapelev2_1_the_main_loop_gsnm1',30,9,1,8,17940 $) call adclose( 'tapelev2_2_the_main_loop_gtnm1',30,9,2,8,17940 $) call adclose( 'tapelev2_3_the_main_loop_gunm1',30,9,3,8,17940 $) call adclose( 'tapelev2_4_the_main_loop_gvnm1',30,9,4,8,17940 $) call adclose( 'tapelev2_5_the_main_loop_theta',30,9,5,8,17940 $) call adclose( 'tapelev2_6_the_main_loop_salt',29,9,6,8,17940 ) call adclose( 'tapelev2_7_the_main_loop_uvel',29,9,7,8,17940 ) call adclose( 'tapelev2_8_the_main_loop_vvel',29,9,8,8,17940 ) call adclose( 'tapelev2_9_the_main_loop_wvel',29,9,9,8,17940 ) call adclose( 'tapelev2_10_the_main_loop_etan',30,9,10,8,1196 $) call adclose( 'tapelev2_11_the_main_loop_etanm1',32,9,11,8, $1196 ) call adclose( 'tapelev2_12_the_main_loop_uveld',31,9,12,8, $17940 ) call adclose( 'tapelev2_13_the_main_loop_vveld',31,9,13,8, $17940 ) call adclose( 'tapelev2_14_the_main_loop_unm1',30,9,14,8, $17940 ) call adclose( 'tapelev2_15_the_main_loop_vnm1',30,9,15,8, $17940 ) endif end do call barrier( mythid ) call adctrl_map_forcing( mythid ) ikey_dynamics = 1 call adinitialise_varia( mythid ) C---------------------------------------------- C CLOSE FILES OF TAPE: tapelev3 C---------------------------------------------- call adclose( 'tapelev3_1_the_main_loop_gsnm1',30,8,1,8,17940 ) call adclose( 'tapelev3_2_the_main_loop_gtnm1',30,8,2,8,17940 ) call adclose( 'tapelev3_3_the_main_loop_gunm1',30,8,3,8,17940 ) call adclose( 'tapelev3_4_the_main_loop_gvnm1',30,8,4,8,17940 ) call adclose( 'tapelev3_5_the_main_loop_theta',30,8,5,8,17940 ) call adclose( 'tapelev3_6_the_main_loop_salt',29,8,6,8,17940 ) call adclose( 'tapelev3_7_the_main_loop_uvel',29,8,7,8,17940 ) call adclose( 'tapelev3_8_the_main_loop_vvel',29,8,8,8,17940 ) call adclose( 'tapelev3_9_the_main_loop_wvel',29,8,9,8,17940 ) call adclose( 'tapelev3_10_the_main_loop_etan',30,8,10,8,1196 ) call adclose( 'tapelev3_11_the_main_loop_etanm1',32,8,11,8,1196 ) call adclose( 'tapelev3_12_the_main_loop_uveld',31,8,12,8,17940 ) call adclose( 'tapelev3_13_the_main_loop_vveld',31,8,13,8,17940 ) call adclose( 'tapelev3_14_the_main_loop_unm1',30,8,14,8,17940 ) call adclose( 'tapelev3_15_the_main_loop_vnm1',30,8,15,8,17940 ) C---------------------------------------------- C GET DEPENDEND VARIABLES C---------------------------------------------- fc = fch end subroutine adtimestep( bi, bj, imin, imax, jmin, jmax, k, $adphihyd, adphisurfx, adphisurfy ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, $adgucd, adgvcd double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /grid_r/ dxc, dxf, dxg, dxv, dyc, dyf, dyg, dyu, drc, drf, $h, hfacc, hfacw, hfacs, depthink, recip_dxc, recip_dxf, recip_dxg, $ recip_dxv, recip_dyc, recip_dyf, recip_dyg, recip_dyu, recip_drc, $ recip_drf, recip_h, recip_hfacc, recip_hfacw, recip_hfacs, rkfac, $ recip_rkfac, safac, xc, yc, ra, raw, ras, raz, rc, rf, yc0, xc0, $xg, yg, maskw, masks, recip_ra, recip_raw, recip_ras, recip_raz, $tanphiatu, tanphiatv double precision depthink(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision drc(1:nr) double precision drf(1:nr) double precision dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision masks(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision maskw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx,nsy) double precision ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision rc(1:nr) double precision recip_drc(1:nr) double precision recip_drf(1:nr) double precision recip_dxc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dxv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyf(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_dyu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_h(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_hfacc(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacs(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_hfacw(1-olx:snx+olx,1-oly:sny+oly,1:nr,nsx, $nsy) double precision recip_ra(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_ras(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raw(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_raz(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision recip_rkfac double precision rf(1:nr+1) double precision rkfac double precision safac(1:nr) double precision tanphiatu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision tanphiatv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision xc0 double precision xg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision yc0 double precision yg(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /parm_l/ usingcartesiangrid, usingsphericalpolargrid, $no_slip_sides, no_slip_bottom, staggertimestep, momviscosity, $momadvection, momforcing, usecoriolis, mompressureforcing, $tempdiffusion, tempadvection, tempforcing, saltdiffusion, $saltadvection, saltforcing, implicitfreesurface, rigidlid, $momstepping, tempstepping, saltstepping, metricterms, $usingsphericalpolarmterms, useconstantf, usebetaplanef, $usespheref, implicitdiffusion, implicitviscosity, $dothetaclimrelax, dosaltclimrelax, periodicexternalforcing, $usingpcoords, usingzcoords, nonhydrostatic, globalfiles, $allowfreezing, groundatk1, usepickupbeforec35 logical allowfreezing logical dosaltclimrelax logical dothetaclimrelax logical globalfiles logical groundatk1 logical implicitdiffusion logical implicitfreesurface logical implicitviscosity logical metricterms logical momadvection logical momforcing logical mompressureforcing logical momstepping logical momviscosity logical no_slip_bottom logical no_slip_sides logical nonhydrostatic logical periodicexternalforcing logical rigidlid logical saltadvection logical saltdiffusion logical saltforcing logical saltstepping logical staggertimestep logical tempadvection logical tempdiffusion logical tempforcing logical tempstepping logical usebetaplanef logical useconstantf logical usecoriolis logical usepickupbeforec35 logical usespheref logical usingcartesiangrid logical usingpcoords logical usingsphericalpolargrid logical usingsphericalpolarmterms logical usingzcoords common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adphihyd(1-olx:snx+olx,1-oly:sny+oly,nr) double precision adphisurfx(1-olx:snx+olx,1-oly:sny+oly) double precision adphisurfy(1-olx:snx+olx,1-oly:sny+oly) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k C============================================== C define local variables C============================================== double precision ab05 double precision ab15 integer i integer j double precision phxfac double precision phyfac double precision psfac C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- ab15 = 1.5+abeps ab05 = (-0.5)-abeps psfac = pffacmom*(1.d0-implicsurfpress) if (staggertimestep) then phyfac = pffacmom*deltatmom do j = jmin, jmax do i = imin, imax adphihyd(i,j-1,k) = adphihyd(i,j-1,k)+adgvnm1(i,j,k,bi,bj)* $recip_dyc(i,j,bi,bj)*phyfac*masks(i,j,k,bi,bj) adphihyd(i,j,k) = adphihyd(i,j,k)-adgvnm1(i,j,k,bi,bj)* $recip_dyc(i,j,bi,bj)*phyfac*masks(i,j,k,bi,bj) end do end do endif do j = jmin, jmax do i = imin, imax adgv(i,j,k,bi,bj) = adgv(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj)* $deltatmom*ab15*masks(i,j,k,bi,bj) adgvcd(i,j,k,bi,bj) = adgvcd(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj) $*deltatmom*masks(i,j,k,bi,bj) adphisurfy(i,j) = adphisurfy(i,j)-adgvnm1(i,j,k,bi,bj)* $deltatmom*psfac*masks(i,j,k,bi,bj) advvel(i,j,k,bi,bj) = advvel(i,j,k,bi,bj)+adgvnm1(i,j,k,bi,bj) adgvnm1(i,j,k,bi,bj) = adgvnm1(i,j,k,bi,bj)*deltatmom*ab05* $masks(i,j,k,bi,bj) end do end do if (staggertimestep) then phxfac = pffacmom*deltatmom do j = jmin, jmax do i = imin, imax adphihyd(i-1,j,k) = adphihyd(i-1,j,k)+adgunm1(i,j,k,bi,bj)* $recip_dxc(i,j,bi,bj)*phxfac*maskw(i,j,k,bi,bj) adphihyd(i,j,k) = adphihyd(i,j,k)-adgunm1(i,j,k,bi,bj)* $recip_dxc(i,j,bi,bj)*phxfac*maskw(i,j,k,bi,bj) end do end do endif psfac = pffacmom*(1.d0-implicsurfpress) do j = jmin, jmax do i = imin, imax adgu(i,j,k,bi,bj) = adgu(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj)* $deltatmom*ab15*maskw(i,j,k,bi,bj) adgucd(i,j,k,bi,bj) = adgucd(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj) $*deltatmom*maskw(i,j,k,bi,bj) adphisurfx(i,j) = adphisurfx(i,j)-adgunm1(i,j,k,bi,bj)* $deltatmom*psfac*maskw(i,j,k,bi,bj) aduvel(i,j,k,bi,bj) = aduvel(i,j,k,bi,bj)+adgunm1(i,j,k,bi,bj) adgunm1(i,j,k,bi,bj) = adgunm1(i,j,k,bi,bj)*deltatmom*ab05* $maskw(i,j,k,bi,bj) end do end do end subroutine adtimestep_tracer( bi, bj, imin, imax, jmin, jmax, k, $adtracer, adgtracer, adgtrnm1 ) C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer npx parameter ( npx = 1 ) integer npy parameter ( npy = 1 ) integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer snx parameter ( snx = 20 ) integer nx parameter ( nx = snx*nsx*npx ) integer sny parameter ( sny = 40 ) integer ny parameter ( ny = sny*nsy*npy ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) C============================================== C define common blocks C============================================== common /parm_r/ cg2dtargetresidual, cg2dpcoffdfac, $cg3dtargetresidual, delp, delz, delr, delx, dely, deltat, $deltatmom, deltattracer, deltatclock, abeps, starttime, phimin, $thetamin, rsphere, recip_rsphere, f0, fcori, beta, viscah, viscaz, $ visca4, viscar, diffkht, diffkzt, diffk4t, diffkrt, diffkhs, $diffkzs, diffk4s, diffkrs, delt, taucd, rcd, freesurffac, $implicsurfpress, implicdiv2dflow, hfacmin, hfacmindz, gravity, $recip_gravity, gbaro, rhonil, recip_rhonil, recip_rhoconst, $rhoconst, tref, sref, endtime, chkptfreq, pchkptfreq, dumpfreq, $tavefreq, affacmom, vffacmom, pffacmom, cffacmom, fofacmom, $mtfacmom, cospower, cadjfreq, omega, tauthetaclimrelax, $lambdathetaclimrelax, tausaltclimrelax, lambdasaltclimrelax, $externforcingcycle, externforcingperiod, viscap, diffkpt, diffkps, $ hfacmindr, hfacmindp, theta_s, specvol_s, horivertratio, $recip_horivertratio, latfftfiltlo, ivdc_kappa, ro_sealevel, $zonal_filt_lat, bottomdraglinear, bottomdragquadratic double precision abeps double precision affacmom double precision beta double precision bottomdraglinear double precision bottomdragquadratic double precision cadjfreq double precision cffacmom double precision cg2dpcoffdfac double precision cg2dtargetresidual double precision cg3dtargetresidual double precision chkptfreq double precision cospower double precision delp(nr) double precision delr(nr) double precision delt double precision deltat double precision deltatclock double precision deltatmom double precision deltattracer double precision delx(nx) double precision dely(ny) double precision delz(nr) double precision diffk4s double precision diffk4t double precision diffkhs double precision diffkht double precision diffkps double precision diffkpt double precision diffkrs double precision diffkrt double precision diffkzs double precision diffkzt double precision dumpfreq double precision endtime double precision externforcingcycle double precision externforcingperiod double precision f0 double precision fcori(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision fofacmom double precision freesurffac double precision gbaro double precision gravity double precision hfacmin double precision hfacmindp double precision hfacmindr double precision hfacmindz double precision horivertratio double precision implicdiv2dflow double precision implicsurfpress double precision ivdc_kappa double precision lambdasaltclimrelax double precision lambdathetaclimrelax double precision latfftfiltlo double precision mtfacmom double precision omega double precision pchkptfreq double precision pffacmom double precision phimin double precision rcd double precision recip_gravity double precision recip_horivertratio double precision recip_rhoconst double precision recip_rhonil double precision recip_rsphere double precision rhoconst double precision rhonil double precision ro_sealevel double precision rsphere double precision specvol_s(nr) double precision sref(nr) double precision starttime double precision taucd double precision tausaltclimrelax double precision tauthetaclimrelax double precision tavefreq double precision theta_s(nr) double precision thetamin double precision tref(nr) double precision vffacmom double precision visca4 double precision viscah double precision viscap double precision viscar double precision viscaz double precision zonal_filt_lat C============================================== C define arguments C============================================== double precision adgtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtrnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtracer(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) integer bi integer bj integer imax integer imin integer jmax integer jmin integer k C============================================== C define local variables C============================================== double precision ab05 double precision ab15 integer i integer j C---------------------------------------------- C ROUTINE BODY C---------------------------------------------- ab15 = 1.5+abeps ab05 = (-0.5)-abeps do j = jmin, jmax do i = imin, imax adgtracer(i,j,k,bi,bj) = adgtracer(i,j,k,bi,bj)+adgtrnm1(i,j, $k,bi,bj)*deltattracer*ab15 adtracer(i,j,k,bi,bj) = adtracer(i,j,k,bi,bj)+adgtrnm1(i,j,k, $bi,bj) adgtrnm1(i,j,k,bi,bj) = adgtrnm1(i,j,k,bi,bj)*deltattracer* $ab05 end do end do end subroutine adzero C*************************************************************** C*************************************************************** C** This routine was generated by the ** C** Tangent linear and Adjoint Model Compiler, TAMC 5.2.14 ** C*************************************************************** C*************************************************************** C============================================== C all entries are defined explicitly C============================================== implicit none C============================================== C define parameters C============================================== integer nr parameter ( nr = 15 ) integer nsx parameter ( nsx = 1 ) integer nsy parameter ( nsy = 1 ) integer olx parameter ( olx = 3 ) integer oly parameter ( oly = 3 ) integer snx parameter ( snx = 20 ) integer sny parameter ( sny = 40 ) C============================================== C define common blocks C============================================== common /adcontrolvars_r/ adtmpfld2d, adtmpfld3d double precision adtmpfld2d(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adtmpfld3d(1-olx:snx+olx,1-oly:sny+oly,nr,nsx, $nsy) common /adcost_r/ adfc, adobjf_test double precision adfc double precision adobjf_test(nsx,nsy) common /addynvars_cd/ aduveld, advveld, adetanm1, adunm1, advnm1, $adgucd, adgvcd double precision adetanm1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgucd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvcd(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advveld(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /addynvars_r/ adetan, aduvel, advvel, adwvel, adtheta, $adsalt, adgu, adgv, adgt, adgs, adgunm1, adgvnm1, adgtnm1, adgsnm1 double precision adetan(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adgs(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgsnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgtnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgu(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgunm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgv(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adgvnm1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adsalt(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adtheta(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision aduvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision advvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) double precision adwvel(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy) common /adffields/ adfu, adfv, adqnet, adempmr double precision adempmr(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adfu(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adfv(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) double precision adqnet(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) common /adtendency_forcing/ adsurfacetendencyu, $adsurfacetendencyv, adsurfacetendencyt, adsurfacetendencys double precision adsurfacetendencys(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyt(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyu(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) double precision adsurfacetendencyv(1-olx:snx+olx,1-oly:sny+oly, $nsx,nsy) C============================================== C define local variables C============================================== integer ip1 integer ip2 integer ip3 integer ip4 integer ip5 do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adtmpfld2d(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adtmpfld3d(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip2 = 1, nsy do ip1 = 1, nsx adobjf_test(ip1,ip2) = 0.d0 end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx aduveld(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advveld(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adetanm1(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adunm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgucd(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgvcd(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adetan(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx aduvel(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx advvel(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adwvel(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adtheta(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adsalt(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgu(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgv(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgt(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgs(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgunm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgvnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgtnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip5 = 1, nsy do ip4 = 1, nsx do ip3 = 1, nr do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adgsnm1(ip1,ip2,ip3,ip4,ip5) = 0.d0 end do end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfu(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adfv(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adqnet(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adempmr(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adsurfacetendencyu(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adsurfacetendencyv(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adsurfacetendencyt(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do do ip4 = 1, nsy do ip3 = 1, nsx do ip2 = 1-oly, sny+oly do ip1 = 1-olx, snx+olx adsurfacetendencys(ip1,ip2,ip3,ip4) = 0.d0 end do end do end do end do end