pkg/autodiff/global_max_ad.F

b043311a0b Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
d2b824a660 Patr*0003 C--   File global_max.F: Routines that perform global max reduction on an array
                0004 C                        of thread values.
                0005 C
                0006 C      Adjoint routines are identical to forward routines,
                0007 C      but parameter list is reversed to be consistent with
                0008 C      call statement generated by TAMC/TAF
                0009 C      P. Heimbach, 16-Apr-2002
                0010 C
                0011 C      Contents
b043311a0b Jean*0012 C      o GLOBAL_ADMAX_R4
                0013 C      o GLOBAL_ADMAX_R8
d2b824a660 Patr*0014
b043311a0b Jean*0015 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d2b824a660 Patr*0016 CBOP
                0017 C     !ROUTINE: GLOBAL_ADMAX_R4
                0018
                0019 C     !INTERFACE:
0a92c8c20d Patr*0020 #ifdef AUTODIFF_TAMC_COMPATIBILITY
b043311a0b Jean*0021       SUBROUTINE GLOBAL_ADMAX_R4(
d2b824a660 Patr*0022      I                            myThid,
                0023      U                            maxPhi
                0024      &                          )
0a92c8c20d Patr*0025 #else
b043311a0b Jean*0026       SUBROUTINE GLOBAL_ADMAX_R4(
0a92c8c20d Patr*0027      U                            maxPhi,
                0028      I                            myThid
                0029      &                          )
                0030 #endif
b043311a0b Jean*0031
d2b824a660 Patr*0032 C     !DESCRIPTION:
                0033 C     *==========================================================*
b043311a0b Jean*0034 C     | SUBROUTINE GLOBAL_ADMAX_R4
                0035 C     | o Handle max for real*4 data.
d2b824a660 Patr*0036 C     *==========================================================*
b043311a0b Jean*0037 C     | Perform max on array of one value per thread and then
                0038 C     | max result of all the processes.
                0039 C     | Notes
                0040 C     | =====
                0041 C     | Within a process only one thread does the max, each
                0042 C     | thread is assumed to have already maxed  its local data.
                0043 C     | The same thread also does the inter-process max for
                0044 C     | example with MPI and then writes the result into a shared
                0045 C     | location. All threads wait until the max is avaiailable.
d2b824a660 Patr*0046 C     *==========================================================*
                0047
                0048 C     !USES:
b043311a0b Jean*0049       IMPLICIT NONE
                0050
d2b824a660 Patr*0051 C     == Global data ==
                0052 #include "SIZE.h"
                0053 #include "EEPARAMS.h"
                0054 #include "EESUPPORT.h"
                0055 #include "GLOBAL_MAX.h"
                0056
                0057 C     !INPUT/OUTPUT PARAMETERS:
                0058 C     == Routine arguments ==
                0059 C     maxPhi :: Result of max.
                0060 C     myThid :: My thread id.
                0061       Real*4 maxPhi
                0062       INTEGER myThid
                0063
                0064 C     !LOCAL VARIABLES:
                0065 C     == Local variables ==
                0066 C     I      :: Loop counters
                0067 C     mpiRC  :: MPI return code
                0068       INTEGER I
                0069       Real*4  tmp
6f81cb0e7d Jean*0070 #ifdef ALLOW_USE_MPI
d2b824a660 Patr*0071       INTEGER mpiRC
                0072 #endif /* ALLOW_USE_MPI */
                0073 CEOP
                0074
                0075 C--   write local max into array
b043311a0b Jean*0076       phiGMR4(1,myThid) = maxPhi
d2b824a660 Patr*0077
                0078 C--   Can not start until everyone is ready
                0079       CALL BAR2( myThid )
                0080
                0081 C--   Max within the process first
                0082       _BEGIN_MASTER( myThid )
b043311a0b Jean*0083        tmp = phiGMR4(1,1)
d2b824a660 Patr*0084        DO I=2,nThreads
b043311a0b Jean*0085         tmp = MAX(tmp,phiGMR4(1,I))
d2b824a660 Patr*0086        ENDDO
                0087        maxPhi = tmp
6f81cb0e7d Jean*0088 #ifdef ALLOW_USE_MPI
d2b824a660 Patr*0089        IF ( usingMPI ) THEN
                0090         CALL MPI_Allreduce(tmp,maxPhi,1,MPI_REAL,MPI_MAX,
b043311a0b Jean*0091      &                   MPI_COMM_MODEL,mpiRC)
d2b824a660 Patr*0092        ENDIF
6f81cb0e7d Jean*0093 #endif /* ALLOW_USE_MPI */
b043311a0b Jean*0094        phiGMR4(1,0) = maxPhi
d2b824a660 Patr*0095       _END_MASTER( myThid )
6f81cb0e7d Jean*0096
                0097 C--   Do not leave until we are sure that the max is done
d2b824a660 Patr*0098       CALL BAR2( myThid )
                0099
                0100 C--   set result for every process
b043311a0b Jean*0101       maxPhi = phiGMR4(1,0)
d2b824a660 Patr*0102
                0103       RETURN
                0104       END
                0105
b043311a0b Jean*0106 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0107 CBOP
d2b824a660 Patr*0108 C     !ROUTINE: GLOBAL_ADMAX_R8
                0109
                0110 C     !INTERFACE:
0a92c8c20d Patr*0111 #ifdef AUTODIFF_TAMC_COMPATIBILITY
b043311a0b Jean*0112       SUBROUTINE GLOBAL_ADMAX_R8(
d2b824a660 Patr*0113      I                            myThid,
0a92c8c20d Patr*0114      U                            maxPhi
d2b824a660 Patr*0115      &                          )
0a92c8c20d Patr*0116 #else
b043311a0b Jean*0117       SUBROUTINE GLOBAL_ADMAX_R8(
0a92c8c20d Patr*0118      U                            maxPhi,
                0119      I                            myThid
                0120      &                          )
                0121 #endif
b043311a0b Jean*0122
d2b824a660 Patr*0123 C     !DESCRIPTION:
                0124 C     *==========================================================*
b043311a0b Jean*0125 C     | SUBROUTINE GLOBAL_ADMAX_R8
                0126 C     | o Handle max for real*8 data.
d2b824a660 Patr*0127 C     *==========================================================*
b043311a0b Jean*0128 C     | Perform max on array of one value per thread and then
                0129 C     | max result of all the processes.
                0130 C     | Notes
                0131 C     | =====
                0132 C     | Within a process only one thread does the max, each
                0133 C     | thread is assumed to have already maxed  its local data.
                0134 C     | The same thread also does the inter-process max for
                0135 C     | example with MPI and then writes the result into a shared
                0136 C     | location. All threads wait until the max is avaiailable.
d2b824a660 Patr*0137 C     *==========================================================*
                0138
                0139 C     !USES:
b043311a0b Jean*0140       IMPLICIT NONE
                0141
d2b824a660 Patr*0142 C     === Global data ===
                0143 #include "SIZE.h"
                0144 #include "EEPARAMS.h"
                0145 #include "EESUPPORT.h"
                0146 #include "GLOBAL_MAX.h"
                0147
                0148 C     !INPUT/OUTPUT PARAMETERS:
                0149 C     === Routine arguments ===
                0150 C     maxPhi :: Result of max.
                0151 C     myThid :: My thread id.
                0152       Real*8 maxPhi
                0153       INTEGER myThid
                0154
                0155 C     !LOCAL VARIABLES:
                0156 C     === Local variables ===
                0157 C     I      :: Loop counters
                0158 C     mpiRC  :: MPI return code
                0159       INTEGER I
                0160       Real*8  tmp
6f81cb0e7d Jean*0161 #ifdef ALLOW_USE_MPI
d2b824a660 Patr*0162       INTEGER mpiRC
                0163 #endif   /* ALLOW_USE_MPI */
                0164 CEOP
                0165
                0166 C--   write local max into array
b043311a0b Jean*0167       phiGMR8(1,myThid) = maxPhi
d2b824a660 Patr*0168
                0169 C--   Can not start until everyone is ready
                0170       CALL BAR2( myThid )
                0171
                0172 C--   Max within the process first
                0173       _BEGIN_MASTER( myThid )
b043311a0b Jean*0174        tmp = phiGMR8(1,1)
d2b824a660 Patr*0175        DO I=2,nThreads
b043311a0b Jean*0176         tmp = MAX(tmp,phiGMR8(1,I))
d2b824a660 Patr*0177        ENDDO
                0178        maxPhi = tmp
6f81cb0e7d Jean*0179 #ifdef ALLOW_USE_MPI
d2b824a660 Patr*0180        IF ( usingMPI ) THEN
                0181         CALL MPI_Allreduce(tmp,maxPhi,1,MPI_DOUBLE_PRECISION,MPI_MAX,
b043311a0b Jean*0182      &                   MPI_COMM_MODEL,mpiRC)
d2b824a660 Patr*0183        ENDIF
6f81cb0e7d Jean*0184 #endif /* ALLOW_USE_MPI */
d2b824a660 Patr*0185 C--     Write solution to place where all threads can see it
b043311a0b Jean*0186        phiGMR8(1,0) = maxPhi
d2b824a660 Patr*0187       _END_MASTER( myThid )
                0188
                0189 C--   Do not leave until we are sure that the max is done
                0190       CALL BAR2( myThid )
                0191
                0192 C--   set result for every process
b043311a0b Jean*0193       maxPhi = phiGMR8(1,0)
d2b824a660 Patr*0194
                0195       RETURN
                0196       END