** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Fri, 1 Jan 2026 06:09:11 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/tapenade/stubs_tap_adj.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2025-11-22 06:08:50 UTC

view on githubraw file Latest commit feb7fa5d on 2025-11-21 15:45:20 UTC
b4daa24319 Shre*0001 #include "CPP_EEOPTIONS.h"
feb7fa5d1e dngo*0002 #include "TAPENADE_OPTIONS.h"
                0003 #ifdef ALLOW_STREAMICE
                0004 # include "STREAMICE_OPTIONS.h"
                0005 #endif      
b4daa24319 Shre*0006 
                0007       SUBROUTINE GLOBAL_MAX_R8_B(rhsmax, rhsmaxb, myThid)
                0008       IMPLICIT NONE
                0009 #include "SIZE.h"
                0010 #include "EEPARAMS.h"
                0011 #include "EESUPPORT.h"
                0012 #include "GLOBAL_MAX.h"
                0013       _RL     rhsmax
                0014       _RL     rhsmaxb
                0015       INTEGER myThid
                0016 
                0017       CALL GLOBAL_ADMAX_R8(rhsmaxb, myThid)
                0018       RETURN
                0019       END
                0020 
                0021       SUBROUTINE GLOBAL_SUM_TILE_RL_B(phiTile, phiTileb,
                0022      &     sumPhi, sumPhib, myThid)
                0023       IMPLICIT NONE
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "EESUPPORT.h"
                0027 #include "GLOBAL_SUM.h"
                0028       _RL     phiTile(nSx,nSy)
                0029       _RL     phiTileb(nSx,nSy)
                0030       _RL     sumPhib
                0031       _RL     sumPhi
                0032       INTEGER myThid
                0033 
                0034       CALL GLOBAL_ADSUM_TILE_RL(phiTileb, sumPhib, myThid)
                0035       END
                0036 
                0037 !     Adjoint of global_sum_r8 for arguments Arg1=(in;out)
                0038       SUBROUTINE GLOBAL_SUM_R8_B(sumPhi, sumPhib, myThid)
                0039       IMPLICIT NONE
                0040 #include "SIZE.h"
                0041 #include "EEPARAMS.h"
                0042 #include "EESUPPORT.h"
                0043 #include "GLOBAL_SUM.h"
                0044       _RL sumPhi
                0045       _RL sumPhib
                0046       INTEGER myThid
                0047 
                0048       CALL GLOBAL_ADSUM_R8(sumPhib, myThid)
                0049       END
                0050 
                0051       SUBROUTINE CG2D_B0(cg2d_b, cg2d_bb, cg2d_x,
                0052      &                cg2d_xb, firstResidual, minResidualSq,
                0053      &                lastResidual,numIters, nIterMin,myThid)
                0054       IMPLICIT NONE
                0055 #include "SIZE.h"
                0056 #include "EEPARAMS.h"
                0057 #include "PARAMS.h"
                0058 #include "CG2D.h"
                0059       _RL  cg2d_b(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0060       _RL  cg2d_bb(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0061       _RL  cg2d_x(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0062       _RL  cg2d_xb(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0063       _RL  firstResidual
                0064       _RL  minResidualSq
                0065       _RL  lastResidual
                0066       INTEGER numIters
                0067       INTEGER nIterMin
                0068       INTEGER myThid
                0069 
                0070 ! [llh] we assume the downstream cg2d_b is passive, which helps us
                0071 !    because it seems the input 2nd arg of cg2d() pollutes its output value:
                0072       cg2d_bb = 0.d0
                0073       CALL CG2D(cg2d_xb, cg2d_bb, firstResidual,
                0074      +        minResidualSq, lastResidual, numIters,
                0075      +        nIterMin, myThid)
                0076 ! [llh] the upstream cg2d_x is passive:
                0077       cg2d_xb = 0.d0
                0078       END
                0079 
                0080       SUBROUTINE ADEXCH_3D_RL( adVar, Nr, myThid )
                0081       IMPLICIT NONE
                0082       Real*8 adVar
                0083       INTEGER Nr
                0084       INTEGER myThid
                0085       WRITE(*,*) "Called not yet defined"
                0086       END
                0087 
                0088       SUBROUTINE ADEXCH_UV_XY_RS( adU, adV, bool, myThid )
                0089       IMPLICIT NONE
                0090       Real*8 adU
                0091       Real*8 adV
                0092       LOGICAL bool
                0093       INTEGER myThid
                0094       WRITE(*,*) "Called not yet defined"
                0095       END
                0096 
                0097       SUBROUTINE ADEXCH_UV_3D_RL( aduVel,advVel, bool, Nr, myThid )
                0098       IMPLICIT NONE
                0099       LOGICAL bool
                0100       Real*8 aduVel
                0101       Real*8 advVel
                0102       INTEGER Nr
                0103       INTEGER myThid
                0104       WRITE(*,*) "Called not yet defined"
                0105       END
                0106 
                0107       SUBROUTINE ADEXCH_XY_RS( adVar, myThid )
                0108       IMPLICIT NONE
                0109       Real*8 adVar
                0110       INTEGER myThid
                0111       WRITE(*,*) "Called not yet defined"
                0112       END
                0113 
                0114       SUBROUTINE ADEXCH_XY_RL( adVar, myThid )
                0115       IMPLICIT NONE
                0116       Real*8 adVar
                0117       INTEGER myThid
                0118       WRITE(*,*) "Called not yet defined"
                0119       END
                0120 
feb7fa5d1e dngo*0121       
                0122       SUBROUTINE STREAMICE_CG_SOLVE_D(cg_uin, cg_uinb, cg_vin, cg_vinb,
                0123      &                                cg_bu, cg_bub, cg_bv, cg_bvb, a_uu
                0124      &                                , a_uub, a_uv, a_uvb, a_vu, a_vub
                0125      &                                , a_vv, a_vvb, tolerance, iters,
                0126      &                                maxiter, mythid)
                0127       IMPLICIT NONE
                0128 
                0129 #include "SIZE.h"
                0130 #include "EEPARAMS.h"
                0131 #include "PARAMS.h"
                0132 
                0133       INTEGER myThid
                0134       INTEGER iters
                0135       INTEGER maxIter
                0136       _RL tolerance
                0137       _RL cg_Uin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0138       _RL cg_Vin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0139       _RL cg_Bu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0140       _RL cg_Bv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0141       _RL
                0142      & A_uu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0143      & A_vu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0144      & A_uv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0145      & A_vv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0146       _RL cg_Uinb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0147       _RL cg_Vinb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0148       _RL cg_Bub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0149       _RL cg_Bvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0150       _RL
                0151      & A_uub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0152      & A_vub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0153      & A_uvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0154      & A_vvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0155       END
                0156 
                0157 
                0158       SUBROUTINE STREAMICE_CG_SOLVE_B(cg_uin, cg_uinb, cg_vin, cg_vinb,
                0159      &                                cg_bu, cg_bub, cg_bv, cg_bvb, a_uu
                0160      &                                , a_uub, a_uv, a_uvb, a_vu, a_vub
                0161      &                                , a_vv, a_vvb, tolerance, iters,
                0162      &                                maxiter, mythid)
                0163 
                0164       IMPLICIT NONE
                0165 
                0166 #include "SIZE.h"
                0167 #include "EEPARAMS.h"
                0168 #include "PARAMS.h"
                0169 #ifdef ALLOW_STREAMICE
                0170 #include "STREAMICE.h"
                0171 #include "STREAMICE_CG.h"
                0172 #endif
                0173 
                0174       INTEGER myThid
                0175       INTEGER iters
                0176       INTEGER maxIter
                0177       _RL tolerance
                0178       _RL cg_Uin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0179       _RL cg_Vin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0180       _RL cg_Bu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0181       _RL cg_Bv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0182       _RL
                0183      & A_uu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0184      & A_vu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0185      & A_uv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0186      & A_vv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0187       _RL cg_Uinb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0188       _RL cg_Vinb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0189       _RL cg_Bub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0190       _RL cg_Bvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0191       _RL
                0192      & A_uub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0193      & A_vub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0194      & A_uvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0195      & A_vvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0196 
                0197 #ifdef ALLOW_STREAMICE
                0198       INTEGER recalc_vel
                0199       recalc_vel = 1
                0200       CALL ADSTREAMICE_CG_SOLVE(
                0201      U                               cg_Uin,    ! velocities - need to be recalc ed
                0202      I                               cg_Uinb,      ! adjoint of vel (input)
                0203      U                               cg_Vin,    ! velocities - need to be recalc ed
                0204      I                               cg_Vinb,      ! adjoint of vel (input)
                0205      I                               cg_Bu,   ! to recalc velocities
                0206      U                               cg_Bub,     ! adjoint of RHS (output)
                0207      I                               cg_Bv,   ! to recalc velocities
                0208      U                               cg_Bvb,     ! adjoint of RHS (output)
                0209      I                               A_uu,       ! section of matrix that multiplies u and projects on u
                0210      U                               A_uub,     ! adjoint of matrix coeffs (output)
                0211      I                               A_uv,       ! section of matrix that multiplies v and projects on u
                0212      U                               A_uvb,     ! adjoint of matrix coeffs (output)
                0213      I                               A_vu,       ! section of matrix that multiplies u and projects on v
                0214      U                               A_vub,     ! adjoint of matrix coeffs (output)
                0215      I                               A_vv,       ! section of matrix that multiplies v and projects on v
                0216      U                               A_vvb,     ! adjoint of matrix coeffs (output)
                0217      I                               tolerance,
                0218      I                               maxiter,
                0219      I                               recalc_vel,
                0220      I                               myThid )
                0221 #endif
                0222       END
                0223 
                0224 C [llh] Hand-written forward-sweep adjoint code of STREAMICE_CG_SOLVE
                0225 C [llh] Adjoint of solving Ax=b,
                0226 C [llh]  where A is (Auu, Auv, Avu, Avv), x is (xu,xv), b is (bu,bv)
                0227       SUBROUTINE STREAMICE_CG_SOLVE_FWD(cg_uin,
                0228      &                                  cg_vin,
                0229      &                                  cg_bu,
                0230      &                                  cg_bv,
                0231      &                                  a_uu, a_uv,
                0232      &                                  a_vu, a_vv,
                0233      &                                  tolerance, iters,
                0234      &                                  maxiters, mythid)
                0235 
                0236 
                0237       IMPLICIT NONE
                0238 
                0239 #include "SIZE.h"
                0240 #include "EEPARAMS.h"
                0241 #include "PARAMS.h"
                0242 #ifdef ALLOW_STREAMICE
                0243 #include "STREAMICE.h"
                0244 #include "STREAMICE_CG.h"
                0245 #endif
                0246 
                0247 
                0248       !INPUT/OUTPUT ARGUMENTS
                0249       _RL cg_Uin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0250       _RL cg_Vin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0251       _RL cg_Bu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0252       _RL cg_Bv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0253       _RL
                0254      & A_uu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0255      & A_vu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0256      & A_uv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0257      & A_vv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0258       _RL tolerance
                0259       INTEGER maxiters
                0260       INTEGER iters
                0261       INTEGER myThid
                0262 
                0263 #ifdef ALLOW_STREAMICE
                0264 
                0265 C     !LOCAL VARIABLES
                0266       INTEGER i, j, bi, bj, colx, coly
                0267       INTEGER conv_flag, tmpiter
                0268       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0269 
                0270       conv_flag = 0
                0271       CALL STREAMICE_CG_SOLVE(
                0272      &  cg_uin,
                0273      &  cg_vin,
                0274      &  cg_bu,
                0275      &  cg_bv,
                0276      &  A_uu,
                0277      &  A_uv,
                0278      &  A_vu,
                0279      &  A_vv,
                0280      &  tolerance,
                0281      &  iters,
                0282      &  maxiters,
                0283      &  myThid )
                0284 
                0285       CALL PUSHREAL8ARRAY(cg_vin, (snx+2*olx)*(sny+2*oly)*nsx*nsy)
                0286       CALL PUSHREAL8ARRAY(cg_uin, (snx+2*olx)*(sny+2*oly)*nsx*nsy)
                0287 #endif
                0288       END
                0289 
                0290 C [llh] Hand-written backward-sweep adjoint code of STREAMICE_CG_SOLVE
                0291 C [llh] Adjoint of solving Ax=b,
                0292 C [llh]  where A is (Auu, Auv, Avu, Avv), x is (xu,xv), b is (bu,bv)
                0293 #ifdef ALLOW_PETSC
                0294       SUBROUTINE STREAMICE_CG_SOLVE_BWD(
                0295      &                                cg_uin, cg_uinb, cg_vin, cg_vinb,
                0296      &                                cg_bu, cg_bub, cg_bv, cg_bvb, a_uu
                0297      &                                , a_uub, a_uv, a_uvb, a_vu, a_vub
                0298      &                                , a_vv, a_vvb, tolerance
                0299      &                                , toleranceb, iters
                0300      &                                , maxiter, mythid)
                0301 #else              
                0302       SUBROUTINE STREAMICE_CG_SOLVE_BWD(
                0303      &                                cg_uin, cg_uinb, cg_vin, cg_vinb,
                0304      &                                cg_bu, cg_bub, cg_bv, cg_bvb, a_uu
                0305      &                                , a_uub, a_uv, a_uvb, a_vu, a_vub
                0306      &                                , a_vv, a_vvb, tolerance, 
                0307      &                                iters, maxiter, 
                0308      &                                mythid)
                0309 #endif              
                0310 
                0311       IMPLICIT NONE
                0312 
                0313 #include "SIZE.h"
                0314 #include "EEPARAMS.h"
                0315 #include "PARAMS.h"
                0316 #ifdef ALLOW_STREAMICE
                0317 #include "STREAMICE.h"
                0318 #include "STREAMICE_CG.h"
                0319 #endif
                0320 
                0321       INTEGER myThid
                0322       INTEGER iters
                0323       INTEGER maxIter
                0324       _RL tolerance
                0325 #ifdef ALLOW_PETSC
                0326       _RL toleranceb
                0327 #endif      
                0328       _RL cg_Uin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0329       _RL cg_Vin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0330       _RL cg_Bu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0331       _RL cg_Bv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0332       _RL
                0333      & A_uu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0334      & A_vu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0335      & A_uv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0336      & A_vv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0337       _RL cg_Uinb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0338       _RL cg_Vinb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0339       _RL cg_Bub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0340       _RL cg_Bvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0341       _RL
                0342      & A_uub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0343      & A_vub (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0344      & A_uvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0345      & A_vvb (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0346 
                0347 #ifdef ALLOW_STREAMICE
                0348 
                0349       CALL POPREAL8ARRAY(cg_Uin, (snx+2*olx)*(sny+2*oly)*nsx*nsy)
                0350       CALL POPREAL8ARRAY(cg_Vin, (snx+2*olx)*(sny+2*oly)*nsx*nsy)
                0351 
                0352 
                0353       CALL ADSTREAMICE_CG_SOLVE(
                0354      U                               cg_Uin,    ! velocities - need to be recalc ed
                0355      I                               cg_Uinb,      ! adjoint of vel (input)
                0356      U                               cg_Vin,    ! velocities - need to be recalc ed
                0357      I                               cg_Vinb,      ! adjoint of vel (input)
                0358      I                               cg_Bu,   ! to recalc velocities
                0359      U                               cg_Bub,     ! adjoint of RHS (output)
                0360      I                               cg_Bv,   ! to recalc velocities
                0361      U                               cg_Bvb,     ! adjoint of RHS (output)
                0362      I                               A_uu,       ! section of matrix that multiplies u and projects on u
                0363      U                               A_uub,     ! adjoint of matrix coeffs (output)
                0364      I                               A_uv,       ! section of matrix that multiplies v and projects on u
                0365      U                               A_uvb,     ! adjoint of matrix coeffs (output)
                0366      I                               A_vu,       ! section of matrix that multiplies u and projects on v
                0367      U                               A_vub,     ! adjoint of matrix coeffs (output)
                0368      I                               A_vv,       ! section of matrix that multiplies v and projects on v
                0369      U                               A_vvb,     ! adjoint of matrix coeffs (output)
                0370      I                               tolerance,
                0371      I                               maxiter,
                0372      I                               myThid )
                0373 #endif
                0374       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!