/[MITgcm]/MITgcm/pkg/autodiff/global_sum_tile_ad.F
ViewVC logotype

Diff of /MITgcm/pkg/autodiff/global_sum_tile_ad.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3 by jmc, Thu Apr 22 22:23:37 2010 UTC revision 1.4 by jmc, Tue Apr 27 16:20:22 2010 UTC
# Line 22  C     !INTERFACE: Line 22  C     !INTERFACE:
22  C     !DESCRIPTION:  C     !DESCRIPTION:
23  C     *==========================================================*  C     *==========================================================*
24  C     | SUBROUTINE GLOBAL\_ADSUM\_TILE\_RL  C     | SUBROUTINE GLOBAL\_ADSUM\_TILE\_RL
25  C     | o Handle sum for _RL data.  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     *==========================================================*  C     *==========================================================*
30  C     | Apply sum on an array of one value per tile  C     | Apply sum on an array of one value per tile
31  C     |  and operate over all tiles & all the processes.  C     |  and operate over all tiles & all the processes.
# Line 34  C     !USES: Line 37  C     !USES:
37  C     == Global data ==  C     == Global data ==
38  #include "SIZE.h"  #include "SIZE.h"
39  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
 #include "GLOBAL_SUM.h"  
40    
41  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
42  C     == Routine arguments ==  C     == Routine arguments ==
43  C     phiTile :: Input array with one value per tile  C     phiTile :: Input array with one value per tile
44  C     sumPhi  :: Result of sum.  C     sumPhi  :: Result of sum.
45  C     myThid  :: My thread id.  C     myThid  :: My Thread Id.
46        _RL     adphiTile(nSx,nSy)        _RL     adphiTile(nSx,nSy)
47        _RL     adsumPhi        _RL     adsumPhi
48        INTEGER myThid        INTEGER myThid
# Line 50  CEOP Line 51  CEOP
51  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
52  C     == Local variables ==  C     == Local variables ==
53  C     bi,bj  :: tile indices  C     bi,bj  :: tile indices
 C     mpiRC  :: MPI return code  
54        INTEGER bi,bj        INTEGER bi,bj
55        Real*8  tmp        Real*8  tmp
 #ifdef   ALLOW_USE_MPI  
       INTEGER mpiRC  
 #endif /* ALLOW_USE_MPI */  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
   
 C--   Can not start until everyone is ready  
       _BARRIER  
   
 C--   broadcast to all processes  
       _BEGIN_MASTER( myThid )  
56    
57        tmp = adsumPhi        tmp = adsumPhi
58    
59  #ifdef  ALLOW_USE_MPI        CALL GLOBAL_SUM_R8( tmp, myThid )
 #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 */  
   
 C---- Testing stage: print a warning (both to std err & outp) when  
 C     current Proc input value is different from Proc-0 value  
       IF ( tmp.NE.adsumPhi ) THEN  
 C-    might need to improve this test if some MPI truncation happen  
         WRITE(msgBuf,'(A,1PE22.14)')  
      &    'GLOBAL_ADSUM_TILE_RL: ** WARNING ** input =', adsumPhi  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT, myThid )  
         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,  
      &                      SQUEEZE_RIGHT, myThid )  
         WRITE(msgBuf,'(A,1PE22.14)')  
      &    'GLOBAL_ADSUM_TILE_RL: ** WARNING ** output=', tmp  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT, myThid )  
         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,  
      &                      SQUEEZE_RIGHT, myThid )  
       ENDIF  
 C----  
   
       phiGSR8(1,0) = tmp  
   
       _END_MASTER( myThid )  
   
       _BARRIER  
60    
61  C--   every thread takes its adjoint sum  C--   each thread takes its tile adjoint sum
62        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
63         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
64           adphiTile(bi,bj) = phiGSR8(1,0)           adphiTile(bi,bj) = tmp
65         ENDDO         ENDDO
66        ENDDO        ENDDO
67  C--   reset input to zero (jmc: is it right ? necessary ?)  C--   reset input to zero (jmc: is it right ? necessary ?)
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22