pkg/autodiff/global_sum_tile_ad.F

C $Header: /u/gcmpack/MITgcm/pkg/autodiff/global_sum_tile_ad.F,v 1.3 2010/04/22 22:23:37 jmc Exp $
C $Name:  $

#include "AUTODIFF_OPTIONS.h"

C--   File global_sum_tile_ad.F: Routines that perform adjoint of
C                          global sum on an array of thread values.
C      Contents
C      o GLOBAL_ADSUM_TILE_RL
C      o GLOBAL_ADSUM_TILE_RS <- not yet coded

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: GLOBAL_ADSUM_TILE_RL

C     !INTERFACE:
      SUBROUTINE GLOBAL_ADSUM_TILE_RL(
     O                        adPhiTile,
     I                        adsumPhi,
     I                        myThid )

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE GLOBAL\_ADSUM\_TILE\_RL
C     | o Adjoint version of global_sum_tile which returns
C     |   global sum over all tiles
C     | Note: Assume that adsumPhi is local to this thread
C     | (i.e., is not a shared var. and is not in a common block)
C     *==========================================================*
C     | Apply sum on an array of one value per tile
C     |  and operate over all tiles & all the processes.
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     phiTile :: Input array with one value per tile
C     sumPhi  :: Result of sum.
C     myThid  :: My Thread Id.
      _RL     adphiTile(nSx,nSy)
      _RL     adsumPhi
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C     == Local variables ==
C     bi,bj  :: tile indices
      INTEGER bi,bj
      Real*8  tmp

      tmp = adsumPhi

      CALL GLOBAL_SUM_R8( tmp, myThid )

C--   each thread takes its tile adjoint sum
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
         adphiTile(bi,bj) = tmp
       ENDDO
      ENDDO
C--   reset input to zero (jmc: is it right ? necessary ?)
c     adsumPhi = 0.

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/pkg/autodiff/global_sum_tile_ad.F,v 1.3 2010/04/22 22:23:37 jmc Exp $
2	C $Name: $
3
4	#include "AUTODIFF_OPTIONS.h"
5
6	C-- File global_sum_tile_ad.F: Routines that perform adjoint of
7	C global sum on an array of thread values.
8	C Contents
9	C o GLOBAL_ADSUM_TILE_RL
10	C o GLOBAL_ADSUM_TILE_RS <- not yet coded
11
12	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
13	CBOP
14	C !ROUTINE: GLOBAL_ADSUM_TILE_RL
15
16	C !INTERFACE:
17	SUBROUTINE GLOBAL_ADSUM_TILE_RL(
18	O adPhiTile,
19	I adsumPhi,
20	I myThid )
21
22	C !DESCRIPTION:
23	C ==========================================================
24	C \| SUBROUTINE GLOBAL\_ADSUM\_TILE\_RL
25	C \| o Adjoint version of global_sum_tile which returns
26	C \| global sum over all tiles
27	C \| Note: Assume that adsumPhi is local to this thread
28	C \| (i.e., is not a shared var. and is not in a common block)
29	C ==========================================================
30	C \| Apply sum on an array of one value per tile
31	C \| and operate over all tiles & all the processes.
32	C ==========================================================
33
34	C !USES:
35	IMPLICIT NONE
36
37	C == Global data ==
38	#include "SIZE.h"
39	#include "EEPARAMS.h"
40
41	C !INPUT/OUTPUT PARAMETERS:
42	C == Routine arguments ==
43	C phiTile :: Input array with one value per tile
44	C sumPhi :: Result of sum.
45	C myThid :: My Thread Id.
46	_RL adphiTile(nSx,nSy)
47	_RL adsumPhi
48	INTEGER myThid
49	CEOP
50
51	C !LOCAL VARIABLES:
52	C == Local variables ==
53	C bi,bj :: tile indices
54	INTEGER bi,bj
55	Real*8 tmp
56
57	tmp = adsumPhi
58
59	CALL GLOBAL_SUM_R8( tmp, myThid )
60
61	C-- each thread takes its tile adjoint sum
62	DO bj = myByLo(myThid), myByHi(myThid)
63	DO bi = myBxLo(myThid), myBxHi(myThid)
64	adphiTile(bi,bj) = tmp
65	ENDDO
66	ENDDO
67	C-- reset input to zero (jmc: is it right ? necessary ?)
68	c adsumPhi = 0.
69
70	RETURN
71	END