Changeset 10299 for NEMO/branches/2018
- Timestamp:
- 2018-11-12T16:48:52+01:00 (6 years ago)
- 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.