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	C $Header: /u/gcmpack/MITgcm/pkg/autodiff/global_sum_tile_ad.F,v 1.1 2009/04/22 01:28:47 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 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	C !USES:
32	IMPLICIT NONE
33
34	C == Global data ==
35	#include "SIZE.h"
36	#include "EEPARAMS.h"
37	#include "EESUPPORT.h"
38	#include "GLOBAL_SUM.h"
39
40	C !INPUT/OUTPUT PARAMETERS:
41	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	C !LOCAL VARIABLES:
51	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	& MPI_COMM_MODEL, mpiRC )
74	#ifndef ALWAYS_USE_MPI
75	ENDIF
76	#endif
77	#endif /* ALLOW_USE_MPI */
78
79	phiGSR8(1,0) = tmp
80
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	adphiTile(bi,bj) = phiGSR8(1,0)
89	ENDDO
90	ENDDO
91	C-- reset input to zero (jmc: is it right ? necessary ?)
92	c adsumPhi = 0.
93
94	RETURN
95	END