pkg/autodiff/global_sum_tile_ad.F

C $Header: /u/gcmpack/MITgcm/pkg/autodiff/global_sum_tile_ad.F,v 1.1 2009/04/22 01:28:47 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 Handle sum for _RL data.
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"
#include "EESUPPORT.h"
#include "GLOBAL_SUM.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
C     mpiRC  :: MPI return code
      INTEGER bi,bj
      Real*8  tmp
#ifdef   ALLOW_USE_MPI
      INTEGER mpiRC
#endif /* ALLOW_USE_MPI */

C--   Can not start until everyone is ready
      _BARRIER

C--   broadcast to all processes
      _BEGIN_MASTER( myThid )

      tmp = adsumPhi

#ifdef  ALLOW_USE_MPI
#ifndef ALWAYS_USE_MPI
      IF ( usingMPI ) THEN
#endif
         CALL MPI_Bcast( tmp, 1, MPI_DOUBLE_PRECISION, 0,
     &                   MPI_COMM_MODEL, mpiRC )
#ifndef ALWAYS_USE_MPI
      ENDIF
#endif
#endif /*  ALLOW_USE_MPI */

      phiGSR8(1,0) = tmp

      _END_MASTER( myThid )
C--
      _BARRIER

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

      RETURN
      END
1	jmc	1.2	C $Header: /u/gcmpack/MITgcm/pkg/autodiff/global_sum_tile_ad.F,v 1.1 2009/04/22 01:28:47 jmc Exp $
2	jmc	1.1	C $Name: $
3
4	jmc	1.2	#include "AUTODIFF_OPTIONS.h"
5
6			C-- File global_sum_tile_ad.F: Routines that perform adjoint of
7	jmc	1.1	C global sum on an array of thread values.
8			C Contents
9	jmc	1.2	C o GLOBAL_ADSUM_TILE_RL
10			C o GLOBAL_ADSUM_TILE_RS <- not yet coded
11	jmc	1.1
12	jmc	1.2	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
13	jmc	1.1	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 Handle sum for _RL data.
26			C ==========================================================
27			C \| Apply sum on an array of one value per tile
28			C \| and operate over all tiles & all the processes.
29			C ==========================================================
30
31	jmc	1.2	C !USES:
32	jmc	1.1	IMPLICIT NONE
33	jmc	1.2
34	jmc	1.1	C == Global data ==
35			#include "SIZE.h"
36			#include "EEPARAMS.h"
37			#include "EESUPPORT.h"
38			#include "GLOBAL_SUM.h"
39
40	jmc	1.2	C !INPUT/OUTPUT PARAMETERS:
41	jmc	1.1	C == Routine arguments ==
42			C phiTile :: Input array with one value per tile
43			C sumPhi :: Result of sum.
44			C myThid :: My thread id.
45			_RL adphiTile(nSx,nSy)
46			_RL adsumPhi
47			INTEGER myThid
48			CEOP
49
50	jmc	1.2	C !LOCAL VARIABLES:
51	jmc	1.1	C == Local variables ==
52			C bi,bj :: tile indices
53			C mpiRC :: MPI return code
54			INTEGER bi,bj
55			Real*8 tmp
56			#ifdef ALLOW_USE_MPI
57			INTEGER mpiRC
58			#endif /* ALLOW_USE_MPI */
59
60			C-- Can not start until everyone is ready
61			_BARRIER
62
63			C-- broadcast to all processes
64			_BEGIN_MASTER( myThid )
65
66			tmp = adsumPhi
67
68			#ifdef ALLOW_USE_MPI
69			#ifndef ALWAYS_USE_MPI
70			IF ( usingMPI ) THEN
71			#endif
72			CALL MPI_Bcast( tmp, 1, MPI_DOUBLE_PRECISION, 0,
73	jmc	1.2	& MPI_COMM_MODEL, mpiRC )
74	jmc	1.1	#ifndef ALWAYS_USE_MPI
75			ENDIF
76			#endif
77			#endif /* ALLOW_USE_MPI */
78
79	jmc	1.2	phiGSR8(1,0) = tmp
80	jmc	1.1
81			_END_MASTER( myThid )
82			C--
83			_BARRIER
84
85			C-- every thread takes its adjoint sum
86			DO bj = myByLo(myThid), myByHi(myThid)
87			DO bi = myBxLo(myThid), myBxHi(myThid)
88	jmc	1.2	adphiTile(bi,bj) = phiGSR8(1,0)
89	jmc	1.1	ENDDO
90			ENDDO
91	jmc	1.2	C-- reset input to zero (jmc: is it right ? necessary ?)
92	jmc	1.1	c adsumPhi = 0.
93
94			RETURN
95			END