pkg/tapenade/stubs_tap_adj.F

b4daa24319 Shre*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003       SUBROUTINE GLOBAL_MAX_R8_B(rhsmax, rhsmaxb, myThid)
                0004       IMPLICIT NONE
                0005 #include "SIZE.h"
                0006 #include "EEPARAMS.h"
                0007 #include "EESUPPORT.h"
                0008 #include "GLOBAL_MAX.h"
                0009       _RL     rhsmax
                0010       _RL     rhsmaxb
                0011       INTEGER myThid
                0012
                0013       CALL GLOBAL_ADMAX_R8(rhsmaxb, myThid)
                0014       RETURN
                0015       END
                0016
                0017       SUBROUTINE GLOBAL_SUM_TILE_RL_B(phiTile, phiTileb,
                0018      &     sumPhi, sumPhib, myThid)
                0019       IMPLICIT NONE
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "EESUPPORT.h"
                0023 #include "GLOBAL_SUM.h"
                0024       _RL     phiTile(nSx,nSy)
                0025       _RL     phiTileb(nSx,nSy)
                0026       _RL     sumPhib
                0027       _RL     sumPhi
                0028       INTEGER myThid
                0029
                0030       CALL GLOBAL_ADSUM_TILE_RL(phiTileb, sumPhib, myThid)
                0031       END
                0032
                0033 !     Adjoint of global_sum_r8 for arguments Arg1=(in;out)
                0034       SUBROUTINE GLOBAL_SUM_R8_B(sumPhi, sumPhib, myThid)
                0035       IMPLICIT NONE
                0036 #include "SIZE.h"
                0037 #include "EEPARAMS.h"
                0038 #include "EESUPPORT.h"
                0039 #include "GLOBAL_SUM.h"
                0040       _RL sumPhi
                0041       _RL sumPhib
                0042       INTEGER myThid
                0043
                0044       CALL GLOBAL_ADSUM_R8(sumPhib, myThid)
                0045       END
                0046
                0047       SUBROUTINE CG2D_B0(cg2d_b, cg2d_bb, cg2d_x,
                0048      &                cg2d_xb, firstResidual, minResidualSq,
                0049      &                lastResidual,numIters, nIterMin,myThid)
                0050       IMPLICIT NONE
                0051 #include "SIZE.h"
                0052 #include "EEPARAMS.h"
                0053 #include "PARAMS.h"
                0054 #include "CG2D.h"
                0055       _RL  cg2d_b(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0056       _RL  cg2d_bb(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0057       _RL  cg2d_x(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0058       _RL  cg2d_xb(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy)
                0059       _RL  firstResidual
                0060       _RL  minResidualSq
                0061       _RL  lastResidual
                0062       INTEGER numIters
                0063       INTEGER nIterMin
                0064       INTEGER myThid
                0065
                0066 ! [llh] we assume the downstream cg2d_b is passive, which helps us
                0067 !    because it seems the input 2nd arg of cg2d() pollutes its output value:
                0068       cg2d_bb = 0.d0
                0069       CALL CG2D(cg2d_xb, cg2d_bb, firstResidual,
                0070      +        minResidualSq, lastResidual, numIters,
                0071      +        nIterMin, myThid)
                0072 ! [llh] the upstream cg2d_x is passive:
                0073       cg2d_xb = 0.d0
                0074       END
                0075
                0076       SUBROUTINE ADEXCH_3D_RL( adVar, Nr, myThid )
                0077       IMPLICIT NONE
                0078       Real*8 adVar
                0079       INTEGER Nr
                0080       INTEGER myThid
                0081       WRITE(*,*) "Called not yet defined"
                0082       END
                0083
                0084       SUBROUTINE ADEXCH_UV_XY_RS( adU, adV, bool, myThid )
                0085       IMPLICIT NONE
                0086       Real*8 adU
                0087       Real*8 adV
                0088       LOGICAL bool
                0089       INTEGER myThid
                0090       WRITE(*,*) "Called not yet defined"
                0091       END
                0092
                0093       SUBROUTINE ADEXCH_UV_3D_RL( aduVel,advVel, bool, Nr, myThid )
                0094       IMPLICIT NONE
                0095       LOGICAL bool
                0096       Real*8 aduVel
                0097       Real*8 advVel
                0098       INTEGER Nr
                0099       INTEGER myThid
                0100       WRITE(*,*) "Called not yet defined"
                0101       END
                0102
                0103       SUBROUTINE ADEXCH_XY_RS( adVar, myThid )
                0104       IMPLICIT NONE
                0105       Real*8 adVar
                0106       INTEGER myThid
                0107       WRITE(*,*) "Called not yet defined"
                0108       END
                0109
                0110       SUBROUTINE ADEXCH_XY_RL( adVar, myThid )
                0111       IMPLICIT NONE
                0112       Real*8 adVar
                0113       INTEGER myThid
                0114       WRITE(*,*) "Called not yet defined"
                0115       END
                0116