pkg/autodiff/global_sum_tile_ad.F

b043311a0b Jean*0001 #include "AUTODIFF_OPTIONS.h"
                0002
                0003 C--   File global_sum_tile_ad.F: Routines that perform adjoint of
e132b398e7 Jean*0004 C                          global sum on an array of thread values.
                0005 C      Contents
b043311a0b Jean*0006 C      o GLOBAL_ADSUM_TILE_RL
                0007 C      o GLOBAL_ADSUM_TILE_RS <- not yet coded
e132b398e7 Jean*0008
b043311a0b Jean*0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e132b398e7 Jean*0010 CBOP
                0011 C     !ROUTINE: GLOBAL_ADSUM_TILE_RL
                0012
                0013 C     !INTERFACE:
                0014       SUBROUTINE GLOBAL_ADSUM_TILE_RL(
314f08b0c1 Jean*0015      U                        adPhiTile,
                0016      U                        adsumPhi,
e132b398e7 Jean*0017      I                        myThid )
                0018
                0019 C     !DESCRIPTION:
                0020 C     *==========================================================*
                0021 C     | SUBROUTINE GLOBAL\_ADSUM\_TILE\_RL
0bef1e86ec Jean*0022 C     | o Adjoint version of global_sum_tile which returns
                0023 C     |   global sum over all tiles
                0024 C     | Note: Assume that adsumPhi is local to this thread
                0025 C     | (i.e., is not a shared var. and is not in a common block)
e132b398e7 Jean*0026 C     *==========================================================*
                0027 C     | Apply sum on an array of one value per tile
                0028 C     |  and operate over all tiles & all the processes.
                0029 C     *==========================================================*
                0030
b043311a0b Jean*0031 C     !USES:
e132b398e7 Jean*0032       IMPLICIT NONE
b043311a0b Jean*0033
e132b398e7 Jean*0034 C     == Global data ==
                0035 #include "SIZE.h"
                0036 #include "EEPARAMS.h"
                0037
b043311a0b Jean*0038 C     !INPUT/OUTPUT PARAMETERS:
e132b398e7 Jean*0039 C     == Routine arguments ==
                0040 C     phiTile :: Input array with one value per tile
                0041 C     sumPhi  :: Result of sum.
0bef1e86ec Jean*0042 C     myThid  :: My Thread Id.
e132b398e7 Jean*0043       _RL     adphiTile(nSx,nSy)
                0044       _RL     adsumPhi
                0045       INTEGER myThid
                0046 CEOP
                0047
b043311a0b Jean*0048 C     !LOCAL VARIABLES:
e132b398e7 Jean*0049 C     == Local variables ==
                0050 C     bi,bj  :: tile indices
                0051       INTEGER bi,bj
                0052       Real*8  tmp
                0053
314f08b0c1 Jean*0054 C note: arithmetic has been checked versus TAF generated adjoint
                0055 C       of a simplified version of global_sum_tile.F code.
                0056
e132b398e7 Jean*0057       tmp = adsumPhi
                0058
0bef1e86ec Jean*0059       CALL GLOBAL_SUM_R8( tmp, myThid )
e132b398e7 Jean*0060
314f08b0c1 Jean*0061 C--   each thread updates its tile adjoint sum
e132b398e7 Jean*0062       DO bj = myByLo(myThid), myByHi(myThid)
                0063        DO bi = myBxLo(myThid), myBxHi(myThid)
314f08b0c1 Jean*0064          adphiTile(bi,bj) = adphiTile(bi,bj) + tmp
e132b398e7 Jean*0065        ENDDO
                0066       ENDDO
314f08b0c1 Jean*0067
cdb21f32cf Mart*0068       adsumPhi = 0.
e132b398e7 Jean*0069
                0070       RETURN
                0071       END