Ignore:
Timestamp:
2018-11-12T16:48:52+01:00 (23 months ago)
Author:
smasson
Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2a: add missing routine from changeset [10297] and [10298], see #2133

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_allreduce_generic.h90

    r10298 r10299  
     1!                          !==  IN: ptab is an array  ==! 
     2#   if defined REAL_TYPE 
     3#      define ARRAY_TYPE(i)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i) 
     4#      define TMP_TYPE(i)      REAL(wp)         , ALLOCATABLE   ::   work(i) 
     5#      define MPI_TYPE mpi_double_precision 
     6#   endif 
     7#   if defined INTEGER_TYPE 
     8#      define ARRAY_TYPE(i)    INTEGER          , INTENT(inout) ::   ARRAY_IN(i) 
     9#      define TMP_TYPE(i)      INTEGER          , ALLOCATABLE   ::   work(i) 
     10#      define MPI_TYPE mpi_integer 
     11#   endif 
     12#   if defined COMPLEX_TYPE 
     13#      define ARRAY_TYPE(i)    COMPLEX          , INTENT(inout) ::   ARRAY_IN(i) 
     14#      define TMP_TYPE(i)      COMPLEX          , ALLOCATABLE   ::   work(i) 
     15#      define MPI_TYPE mpi_double_complex 
     16#   endif 
     17#   if defined DIM_0d 
     18#      define ARRAY_IN(i)   ptab 
     19#      define I_SIZE(ptab)          1 
     20#   endif 
     21#   if defined DIM_1d 
     22#      define ARRAY_IN(i)   ptab(i) 
     23#      define I_SIZE(ptab)          SIZE(ptab,1) 
     24#   endif 
     25#   if defined OPERATION_MAX 
     26#      define MPI_OPERATION mpi_max 
     27#   endif 
     28#   if defined OPERATION_MIN 
     29#      define MPI_OPERATION mpi_min 
     30#   endif 
     31#   if defined OPERATION_SUM 
     32#      define MPI_OPERATION mpi_sum 
     33#   endif 
     34#   if defined OPERATION_SUM_DD 
     35#      define MPI_OPERATION mpi_sumdd 
     36#   endif 
     37 
     38   SUBROUTINE ROUTINE_ALLREDUCE( cdname, ptab, kdim, kcom ) 
     39      !!---------------------------------------------------------------------- 
     40      CHARACTER(len=*),                   INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     41      ARRAY_TYPE(:)   ! array or pointer of arrays on which the boundary condition is applied 
     42      INTEGER, OPTIONAL, INTENT(in   ) ::   kdim        ! optional pointer dimension 
     43      INTEGER, OPTIONAL, INTENT(in   ) ::   kcom        ! optional communicator 
     44      ! 
     45      INTEGER :: ipi, ii, ierr 
     46      INTEGER :: ierror, ilocalcomm 
     47      TMP_TYPE(:) 
     48      ! 
     49      ilocalcomm = mpi_comm_oce 
     50      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     51      ! 
     52      IF( PRESENT(kdim) ) then 
     53         ipi = kdim 
     54      ELSE 
     55         ipi = I_SIZE(ptab)   ! 1st dimension 
     56      ENDIF 
     57 
     58      ALLOCATE(work(ipi)) 
     59      CALL mpi_allreduce( ARRAY_IN(:), work, ipi, MPI_TYPE, MPI_OPERATION, ilocalcomm, ierror ) 
     60      DO ii = 1, ipi 
     61         ARRAY_IN(ii) = work(ii) 
     62      ENDDO 
     63      DEALLOCATE(work) 
     64      ! 
     65      IF( narea == 1 .AND. ncom_stp == nit000+5 ) THEN 
     66            IF( .NOT. ALLOCATED( crname_glb) ) THEN 
     67               ALLOCATE( crname_glb(2000), STAT=ierr ) 
     68               IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'allreduce_generic, cannot allocate crname' ) 
     69            ENDIF 
     70            n_sequence_glb = n_sequence_glb + 1 
     71            IF( n_sequence_glb > 2000 ) CALL ctl_stop( 'STOP', 'allreduce_generic, increase crname_glb first dimension' ) 
     72            crname_glb(n_sequence_glb)   = cdname    ! keep the name of the calling routine 
     73      ENDIF 
     74 
     75   END SUBROUTINE ROUTINE_ALLREDUCE 
     76 
     77#undef ARRAY_TYPE 
     78#undef ARRAY_IN 
     79#undef I_SIZE 
     80#undef MPI_OPERATION 
     81#undef TMP_TYPE 
     82#undef MPI_TYPE 
Note: See TracChangeset for help on using the changeset viewer.