! ============================================================================================================================== ! MODULE : mod_orchidee_mpi_transfert ! ! CONTACT : orchidee-help _at_ listes.ipsl.fr ! ! LICENCE : IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! !>\BRIEF Low level MPI parallel communication encapsulations for ORCHIDEE. !! !!\n DESCRIPTION : This module contains low level interfaces to communicate information to all MPI processes. !! The interfaces in this module are only used by mod_orchidee_transfert_para to create high level interfaces. !! Note that these interfaces are only called by the master OMP thread on each MPI process. !! The interfaces in this module are: !! - bcast_mpi, scatter_mpi, gather_mpi_s, scatter_2D_mpi, gather_2D_mpi, reduced_sum_mpi !! !! RECENT CHANGE(S): None !! !! REFERENCES(S) : None !! !! SVN : !! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90 $ !! $Date: 2018-08-02 09:06:40 +0200 (Thu, 02 Aug 2018) $ !! $Revision: 5364 $ !! \n !_ ================================================================================================================================ MODULE mod_orchidee_mpi_transfert !- USE defprec USE mod_orchidee_para_var USE timer !- IMPLICIT NONE !- #include "src_parallel.h" !- !! ============================================================================================================================== !! INTERFACE : bcast_mpi !! !>\BRIEF Send a variable from root process to all MPI processes !! !! DESCRIPTION : Send a variable from root process to all MPI processes. Need to be call under OMP MASTER !! !! \n !_ ================================================================================================================================ INTERFACE bcast_mpi MODULE PROCEDURE bcast_mpi_c, bcast_mpi_c1, & bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, & bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, & bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4 END INTERFACE !! ============================================================================================================================== !! INTERFACE : scatter_mpi !! !>\BRIEF Distribute a global field from the root process to the local domain on each MPI processes (on kjpindex) !! !! DESCRIPTION : Distribute a global field from the root process to the local domain on each MPI processes. !! Need to be call under OMP MASTER !! !! \n !_ ================================================================================================================================ INTERFACE scatter_mpi MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, & scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, & scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3 END INTERFACE !! ============================================================================================================================== !! INTERFACE : gather_mpi_s !! !>\BRIEF gather a variable (on kjpindex) on the global grid. (With call of suspend time) !! !! DESCRIPTION : gather a variable on the global grid. (With call of suspend time) !! !! \n !_ ================================================================================================================================ INTERFACE gather_mpi_s MODULE PROCEDURE gather_mpi_is, & gather_mpi_rs, & gather_mpi_ls END INTERFACE !! ============================================================================================================================== !! INTERFACE : gather_mpi !! !>\BRIEF Each process MPI send their local field (on kjpindex) to the root process which will recieve !! the field on the global domain !! !! DESCRIPTION : Each process MPI send their local field (on kjpindex) to the root process which will recieve !! the field on the global domain. !! Need to be call under OMP MASTER !! !! \n !_ ================================================================================================================================ INTERFACE gather_mpi MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, & gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, & gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3 END INTERFACE INTERFACE scatter_unindexed_mpi MODULE PROCEDURE scatter_unindexed_mpi_i,scatter_unindexed_mpi_i1,scatter_unindexed_mpi_i2,scatter_unindexed_mpi_i3, & scatter_unindexed_mpi_r,scatter_unindexed_mpi_r1,scatter_unindexed_mpi_r2,scatter_unindexed_mpi_r3, & scatter_unindexed_mpi_l,scatter_unindexed_mpi_l1,scatter_unindexed_mpi_l2,scatter_unindexed_mpi_l3 END INTERFACE INTERFACE gather_unindexed_mpi MODULE PROCEDURE gather_unindexed_mpi_i,gather_unindexed_mpi_i1,gather_unindexed_mpi_i2,gather_unindexed_mpi_i3, & gather_unindexed_mpi_r,gather_unindexed_mpi_r1,gather_unindexed_mpi_r2,gather_unindexed_mpi_r3, & gather_unindexed_mpi_l,gather_unindexed_mpi_l1,gather_unindexed_mpi_l2,gather_unindexed_mpi_l3 END INTERFACE !! ============================================================================================================================== !! INTERFACE : scatter2D_mpi !! !>\BRIEF Distribute a global field (lon,lat) from the root process to the local domain on each processes MPI !! !! DESCRIPTION : Distribute a global field (lon,lat) from the root process to the local domain on each processes MPI !! !! \n !_ ================================================================================================================================ INTERFACE scatter2D_mpi MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, & scatter2D_mpi_r0,scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, & scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3 END INTERFACE !! ============================================================================================================================== !! INTERFACE : gather2D_mpi !! !>\BRIEF Each process MPI send their local field (on lon,lat) to the root process which will recieve !! the field on the global domain !! !! DESCRIPTION : !! !! \n !_ ================================================================================================================================ INTERFACE gather2D_mpi MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, & gather2D_mpi_r0,gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, & gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3 END INTERFACE !! ============================================================================================================================== !! INTERFACE : reduce_sum_mpi !! !>\BRIEF The root process will recieve the sum of the values from all processe !! !! DESCRIPTION :The root process will recieve the sum of the values from all processe. Need to be call under OMP MASTER !! !! \n !_ ================================================================================================================================ INTERFACE reduce_sum_mpi MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, & reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4 END INTERFACE CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Definition of Broadcast 1D --> 4D !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! -- Character string -- !! SUBROUTINE bcast_mpi_c(var) IMPLICIT NONE CHARACTER(LEN=*),INTENT(INOUT) :: Var CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1 #ifndef CPP_PARA RETURN #else IF (is_mpi_root) & Var1(1)=Var CALL orch_bcast_mpi_cgen(Var1,1) Var=Var1(1) #endif END SUBROUTINE bcast_mpi_c SUBROUTINE bcast_mpi_c1(var) IMPLICIT NONE CHARACTER(LEN=*),INTENT(INOUT) :: Var(:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_cgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_c1 !! -- Integers -- !! SUBROUTINE bcast_mpi_i(var) IMPLICIT NONE INTEGER(i_std),INTENT(INOUT) :: Var INTEGER(i_std),DIMENSION(1) :: Var1 #ifndef CPP_PARA RETURN #else IF (is_mpi_root) & Var1(1)=Var CALL orch_bcast_mpi_igen(Var1,1) Var=Var1(1) #endif END SUBROUTINE bcast_mpi_i SUBROUTINE bcast_mpi_i1(var) IMPLICIT NONE INTEGER(i_std),INTENT(INOUT) :: Var(:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_igen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_i1 SUBROUTINE bcast_mpi_i2(var) IMPLICIT NONE INTEGER(i_std),INTENT(INOUT) :: Var(:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_igen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_i2 SUBROUTINE bcast_mpi_i3(var) IMPLICIT NONE INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_igen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_i3 SUBROUTINE bcast_mpi_i4(var) IMPLICIT NONE INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_igen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_i4 !! -- Reals -- !! SUBROUTINE bcast_mpi_r(var) IMPLICIT NONE REAL(r_std),INTENT(INOUT) :: Var REAL(r_std),DIMENSION(1) :: Var1 #ifndef CPP_PARA RETURN #else IF (is_mpi_root) & Var1(1)=Var CALL orch_bcast_mpi_rgen(Var1,1) Var=Var1(1) #endif END SUBROUTINE bcast_mpi_r SUBROUTINE bcast_mpi_r1(var) IMPLICIT NONE REAL(r_std),INTENT(INOUT) :: Var(:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_rgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_r1 SUBROUTINE bcast_mpi_r2(var) IMPLICIT NONE REAL(r_std),INTENT(INOUT) :: Var(:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_rgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_r2 SUBROUTINE bcast_mpi_r3(var) IMPLICIT NONE REAL(r_std),INTENT(INOUT) :: Var(:,:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_rgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_r3 SUBROUTINE bcast_mpi_r4(var) IMPLICIT NONE REAL(r_std),INTENT(INOUT) :: Var(:,:,:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_rgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_r4 !! -- Logicals -- !! SUBROUTINE bcast_mpi_l(var) IMPLICIT NONE LOGICAL,INTENT(INOUT) :: Var LOGICAL,DIMENSION(1) :: Var1 #ifndef CPP_PARA RETURN #else IF (is_mpi_root) & Var1(1)=Var CALL orch_bcast_mpi_lgen(Var1,1) Var=Var1(1) #endif END SUBROUTINE bcast_mpi_l SUBROUTINE bcast_mpi_l1(var) IMPLICIT NONE LOGICAL,INTENT(INOUT) :: Var(:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_lgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_l1 SUBROUTINE bcast_mpi_l2(var) IMPLICIT NONE LOGICAL,INTENT(INOUT) :: Var(:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_lgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_l2 SUBROUTINE bcast_mpi_l3(var) IMPLICIT NONE LOGICAL,INTENT(INOUT) :: Var(:,:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_lgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_l3 SUBROUTINE bcast_mpi_l4(var) IMPLICIT NONE LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) #ifndef CPP_PARA RETURN #else CALL orch_bcast_mpi_lgen(Var,size(Var)) #endif END SUBROUTINE bcast_mpi_l4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Definition of Scatter 1D --> 4D !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE scatter_mpi_i(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1) ELSE CALL orch_scatter_mpi_igen(dummy,Varout,1,1) ENDIF #endif END SUBROUTINE scatter_mpi_i SUBROUTINE scatter_mpi_i1(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)) ELSE CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)) ENDIF #endif END SUBROUTINE scatter_mpi_i1 SUBROUTINE scatter_mpi_i2(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)) ELSE CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter_mpi_i2 SUBROUTINE scatter_mpi_i3(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter_mpi_i3 SUBROUTINE scatter_mpi_r(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1) ELSE CALL orch_scatter_mpi_rgen(dummy,Varout,1,1) ENDIF #endif END SUBROUTINE scatter_mpi_r SUBROUTINE scatter_mpi_r1(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)) ELSE CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)) ENDIF #endif END SUBROUTINE scatter_mpi_r1 SUBROUTINE scatter_mpi_r2(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)) ELSE CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter_mpi_r2 SUBROUTINE scatter_mpi_r3(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter_mpi_r3 SUBROUTINE scatter_mpi_l(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1) ELSE CALL orch_scatter_mpi_lgen(dummy,Varout,1,1) ENDIF #endif END SUBROUTINE scatter_mpi_l SUBROUTINE scatter_mpi_l1(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)) ELSE CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)) ENDIF #endif END SUBROUTINE scatter_mpi_l1 SUBROUTINE scatter_mpi_l2(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)) ELSE CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter_mpi_l2 SUBROUTINE scatter_mpi_l3(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter_mpi_l3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Definition of Gather 1D --> 4D !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE gather_mpi_is(VarIn, VarOut) IMPLICIT NONE #ifdef CPP_PARA INCLUDE 'mpif.h' #endif INTEGER(i_std),INTENT(IN) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. #endif #ifndef CPP_PARA VarOut(:)=VarIn RETURN #else IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (check) & WRITE(numout,*) "gather_mpi_is VarIn=",VarIn #ifdef CPP_PARA CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr) #endif IF (check) & WRITE(numout,*) "gather_mpi_is VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) #endif END SUBROUTINE gather_mpi_is SUBROUTINE gather_mpi_rs(VarIn, VarOut) IMPLICIT NONE #ifdef CPP_PARA INCLUDE 'mpif.h' #endif REAL(r_std),INTENT(IN) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. #endif #ifndef CPP_PARA VarOut(:)=VarIn RETURN #else IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (check) & WRITE(numout,*) "gather_mpi_rs VarIn=",VarIn #ifdef CPP_PARA CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr) #endif IF (check) & WRITE(numout,*) "gather_mpi_rs VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) #endif END SUBROUTINE gather_mpi_rs SUBROUTINE gather_mpi_ls(VarIn, VarOut) IMPLICIT NONE #ifdef CPP_PARA INCLUDE 'mpif.h' #endif LOGICAL,INTENT(IN) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. #endif #ifndef CPP_PARA VarOut(:)=VarIn RETURN #else IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (check) & WRITE(numout,*) "gather_mpi_ls VarIn=",VarIn #ifdef CPP_PARA CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr) #endif IF (check) & WRITE(numout,*) "gather_mpi_ls VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) #endif END SUBROUTINE gather_mpi_ls !!!!! --> Integers SUBROUTINE gather_mpi_i(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1) ELSE CALL orch_gather_mpi_igen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather_mpi_i !!!!! SUBROUTINE gather_mpi_i1(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)) ELSE CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)) ENDIF #endif END SUBROUTINE gather_mpi_i1 !!!!! SUBROUTINE gather_mpi_i2(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)) ELSE CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather_mpi_i2 !!!!! SUBROUTINE gather_mpi_i3(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather_mpi_i3 !!!!! --> Reals SUBROUTINE gather_mpi_r(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1) ELSE CALL orch_gather_mpi_rgen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather_mpi_r !!!!! SUBROUTINE gather_mpi_r1(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)) ELSE CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)) ENDIF #endif END SUBROUTINE gather_mpi_r1 !!!!! SUBROUTINE gather_mpi_r2(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)) ELSE CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather_mpi_r2 !!!!! SUBROUTINE gather_mpi_r3(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather_mpi_r3 !!!!! --> Logicals SUBROUTINE gather_mpi_l(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1) ELSE CALL orch_gather_mpi_lgen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather_mpi_l !!!!! SUBROUTINE gather_mpi_l1(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)) ELSE CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)) ENDIF #endif END SUBROUTINE gather_mpi_l1 !!!!! SUBROUTINE gather_mpi_l2(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)) ELSE CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather_mpi_l2 !!!!! SUBROUTINE gather_mpi_l3(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather_mpi_l3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Definition des Scatter_unindexed --> 4D !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE scatter_unindexed_mpi_i(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1) ELSE CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,1) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_i SUBROUTINE scatter_unindexed_mpi_i1(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)) ELSE CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_i1 SUBROUTINE scatter_unindexed_mpi_i2(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)) ELSE CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_i2 SUBROUTINE scatter_unindexed_mpi_i3(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_i3 SUBROUTINE scatter_unindexed_mpi_r(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1) ELSE CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,1) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_r SUBROUTINE scatter_unindexed_mpi_r1(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)) ELSE CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_r1 SUBROUTINE scatter_unindexed_mpi_r2(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)) ELSE CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_r2 SUBROUTINE scatter_unindexed_mpi_r3(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_r3 SUBROUTINE scatter_unindexed_mpi_l(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1) ELSE CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,1) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_l SUBROUTINE scatter_unindexed_mpi_l1(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)) ELSE CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_l1 SUBROUTINE scatter_unindexed_mpi_l2(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)) ELSE CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_l2 SUBROUTINE scatter_unindexed_mpi_l3(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter_unindexed_mpi_l3 !!!!! --> Les entiers SUBROUTINE gather_unindexed_mpi_i(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1) ELSE CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_i !!!!! SUBROUTINE gather_unindexed_mpi_i1(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)) ELSE CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_i1 !!!!! SUBROUTINE gather_unindexed_mpi_i2(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)) ELSE CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_i2 !!!!! SUBROUTINE gather_unindexed_mpi_i3(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_i3 !!!!! --> Les reels SUBROUTINE gather_unindexed_mpi_r(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1) ELSE CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_r !!!!! SUBROUTINE gather_unindexed_mpi_r1(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)) ELSE CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_r1 !!!!! SUBROUTINE gather_unindexed_mpi_r2(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)) ELSE CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_r2 !!!!! SUBROUTINE gather_unindexed_mpi_r3(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_r3 !!!!! --> Les booleen SUBROUTINE gather_unindexed_mpi_l(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1) ELSE CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_l !!!!! SUBROUTINE gather_unindexed_mpi_l1(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)) ELSE CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_l1 !!!!! SUBROUTINE gather_unindexed_mpi_l2(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)) ELSE CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_l2 !!!!! SUBROUTINE gather_unindexed_mpi_l3(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather_unindexed_mpi_l3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Definition of Scatter2D --> 4D !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE scatter2D_mpi_i(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1) ELSE CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,1) ENDIF #endif END SUBROUTINE scatter2D_mpi_i SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)) ELSE CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter2D_mpi_i1 SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter2D_mpi_i2 SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) ELSE CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) ENDIF #endif END SUBROUTINE scatter2D_mpi_i3 SUBROUTINE scatter2D_mpi_r0(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1),1) ELSE CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1) ENDIF #endif END SUBROUTINE scatter2D_mpi_r0 SUBROUTINE scatter2D_mpi_r(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn REAL(r_std),INTENT(INOUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1) ELSE CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1) ENDIF #endif END SUBROUTINE scatter2D_mpi_r SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)) ELSE CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter2D_mpi_r1 SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter2D_mpi_r2 SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) ELSE CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) ENDIF #endif END SUBROUTINE scatter2D_mpi_r3 SUBROUTINE scatter2D_mpi_l(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1) ELSE CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,1) ENDIF #endif END SUBROUTINE scatter2D_mpi_l SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn LOGICAL,INTENT(INOUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)) ELSE CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)) ENDIF #endif END SUBROUTINE scatter2D_mpi_l1 SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)) ELSE CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)) ENDIF #endif END SUBROUTINE scatter2D_mpi_l2 SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) ELSE CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) ENDIF #endif END SUBROUTINE scatter2D_mpi_l3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Definition of Gather2D --> 4D !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE gather2D_mpi_i(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1) ELSE CALL orch_gather2D_mpi_igen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather2D_mpi_i SUBROUTINE gather2D_mpi_i1(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)) ELSE CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather2D_mpi_i1 SUBROUTINE gather2D_mpi_i2(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather2D_mpi_i2 SUBROUTINE gather2D_mpi_i3(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) ELSE CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) ENDIF #endif END SUBROUTINE gather2D_mpi_i3 SUBROUTINE gather2D_mpi_r0(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1) ELSE CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather2D_mpi_r0 SUBROUTINE gather2D_mpi_r(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1) ELSE CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather2D_mpi_r SUBROUTINE gather2D_mpi_r1(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)) ELSE CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather2D_mpi_r1 SUBROUTINE gather2D_mpi_r2(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather2D_mpi_r2 SUBROUTINE gather2D_mpi_r3(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) ELSE CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) ENDIF #endif END SUBROUTINE gather2D_mpi_r3 SUBROUTINE gather2D_mpi_l(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1) ELSE CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,1) ENDIF #endif END SUBROUTINE gather2D_mpi_l SUBROUTINE gather2D_mpi_l1(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,3)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)) ELSE CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)) ENDIF #endif END SUBROUTINE gather2D_mpi_l1 SUBROUTINE gather2D_mpi_l2(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)) ELSE CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)) ENDIF #endif END SUBROUTINE gather2D_mpi_l2 SUBROUTINE gather2D_mpi_l3(VarIn, VarOut) IMPLICIT NONE LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut #ifdef CPP_PARA LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) ELSE CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) ENDIF #endif END SUBROUTINE gather2D_mpi_l3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Definition of reduce_sum --> 4D !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: VarIn INTEGER(i_std),INTENT(OUT) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: Var1 INTEGER(i_std),DIMENSION(1) :: Var2 INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut=VarIn RETURN #else Var1(1)=VarIn IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_igen(Var1,Var2,1) VarOut=Var2(1) ELSE CALL orch_reduce_sum_mpi_igen(Var1,dummy,1) VarOut=VarIn ENDIF #endif END SUBROUTINE reduce_sum_mpi_i SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_i1 SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_i2 SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_i3 SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut) IMPLICIT NONE INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA INTEGER(i_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_i4 SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN) :: VarIn REAL(r_std),INTENT(OUT) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: Var1 REAL(r_std),DIMENSION(1) :: Var2 REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut=VarIn RETURN #else Var1(1)=VarIn IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_rgen(Var1,Var2,1) VarOut=Var2(1) ELSE CALL orch_reduce_sum_mpi_rgen(Var1,dummy,1) VarOut=VarIn ENDIF #endif END SUBROUTINE reduce_sum_mpi_r SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:)=VarIn(:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_r1 SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:)=VarIn(:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_r2 SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:)=VarIn(:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_r3 SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut) IMPLICIT NONE REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut #ifdef CPP_PARA REAL(r_std),DIMENSION(1) :: dummy #endif #ifndef CPP_PARA VarOut(:,:,:,:)=VarIn(:,:,:,:) RETURN #else IF (is_mpi_root) THEN CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) ELSE CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn)) ENDIF #endif END SUBROUTINE reduce_sum_mpi_r4 END MODULE mod_orchidee_mpi_transfert #ifdef CPP_PARA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! DEFINITION OF GENERIC TRANSFERT SUBROUTINES !! !! These subroutines are only used localy in this module !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE orch_bcast_mpi_cgen(var,nb) USE mod_orchidee_para_var USE timer IMPLICIT NONE CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var INTEGER(i_std),INTENT(IN) :: nb INCLUDE 'mpif.h' INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (check) & WRITE(numout,*) "orch_bcast_mpi_cgen before bcast Var",Var IF (flag) CALL suspend_timer(timer_mpi) CALL MPI_BCAST(Var,nb*LEN(Var(1)),MPI_CHARACTER,mpi_rank_root,MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_bcast_mpi_cgen after bcast Var",Var END SUBROUTINE orch_bcast_mpi_cgen SUBROUTINE orch_bcast_mpi_igen(var,nb) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),DIMENSION(nb),INTENT(INOUT) :: Var INTEGER(i_std),INTENT(IN) :: nb INCLUDE 'mpif.h' INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_bcast_mpi_igen before bcast Var",Var CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_bcast_mpi_igen after bcast Var",Var END SUBROUTINE orch_bcast_mpi_igen SUBROUTINE orch_bcast_mpi_rgen(var,nb) USE mod_orchidee_para_var USE timer IMPLICIT NONE REAL(r_std),DIMENSION(nb),INTENT(INOUT) :: Var INTEGER(i_std),INTENT(IN) :: nb INCLUDE 'mpif.h' INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (check) & WRITE(numout,*) "orch_bcast_mpi_rgen before bcast Var",Var IF (flag) CALL suspend_timer(timer_mpi) CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_bcast_mpi_rgen after bcast Var",Var END SUBROUTINE orch_bcast_mpi_rgen SUBROUTINE orch_bcast_mpi_lgen(var,nb) USE mod_orchidee_para_var USE timer IMPLICIT NONE LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var INTEGER(i_std),INTENT(IN) :: nb INCLUDE 'mpif.h' INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (check) & WRITE(numout,*) "orch_bcast_mpi_lgen before bcast Var",Var IF (flag) CALL suspend_timer(timer_mpi) CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_bcast_mpi_lgen after bcast Var",Var END SUBROUTINE orch_bcast_mpi_lgen SUBROUTINE orch_scatter_mpi_igen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: nbp INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_Para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) displs(rank)=Index_Para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter_mpi_igen VarIn",VarIn WRITE(numout,*) "orch_scatter_mpi_igen VarTmp",VarTmp ENDIF ENDIF CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,nbp_mpi*dimsize, & MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter_mpi_igen VarOut",VarOut END SUBROUTINE orch_scatter_mpi_igen SUBROUTINE orch_scatter_mpi_rgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter_mpi_rgen VarIn",VarIn WRITE(numout,*) "orch_scatter_mpi_rgen VarTmp",VarTmp ENDIF ENDIF CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,nbp_mpi*dimsize, & MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter_mpi_rgen VarOut",VarOut END SUBROUTINE orch_scatter_mpi_rgen SUBROUTINE orch_scatter_mpi_lgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter_mpi_lgen VarIn",VarIn WRITE(numout,*) "orch_scatter_mpi_lgen VarTmp",VarTmp ENDIF ENDIF CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,nbp_mpi*dimsize, & MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter_mpi_lgen VarOut",VarOut END SUBROUTINE orch_scatter_mpi_lgen SUBROUTINE orch_gather_mpi_igen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp INTEGER(i_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1 ENDIF CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_INT_ORCH,VarTmp,counts,displs, & MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) DO i=1,dimsize VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (check) & WRITE(numout,*) "orch_gather_mpi_igen VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) END SUBROUTINE orch_gather_mpi_igen SUBROUTINE orch_gather_mpi_rgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp REAL(r_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1 ENDIF IF (check) & WRITE(numout,*) "orch_gather_mpi_rgen VarIn=",VarIn CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs, & MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_gather_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) DO i=1,dimsize VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (check) & WRITE(numout,*) "orch_gather_mpi_rgen VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) END SUBROUTINE orch_gather_mpi_rgen SUBROUTINE orch_gather_mpi_lgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1 ENDIF IF (check) & WRITE(numout,*) "orch_gather_mpi_lgen VarIn=",VarIn CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs, & MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_gather_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=nbp_mpi_para(rank) DO i=1,dimsize VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (check) & WRITE(numout,*) "orch_gather_mpi_lgen VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) END SUBROUTINE orch_gather_mpi_lgen SUBROUTINE orch_scatter_unindexed_mpi_igen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: nbp INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(ij_nb,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts INTEGER(i_std),DIMENSION(dimsize*iim_g*jjm_g) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_Para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_Para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter_unindexed_mpi_igen VarIn",VarIn WRITE(numout,*) "orch_scatter_unindexed_mpi_igen VarTmp",VarTmp ENDIF ENDIF CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,ij_nb*dimsize, & MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter_unindexed_mpi_igen VarOut",VarOut END SUBROUTINE orch_scatter_unindexed_mpi_igen SUBROUTINE orch_scatter_unindexed_mpi_rgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(ij_nb,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts REAL(r_std),DIMENSION(dimsize*iim_g*jjm_g) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter_unindexed_mpi_rgen VarIn",VarIn WRITE(numout,*) "orch_scatter_unindexed_mpi_rgen VarTmp",VarTmp ENDIF ENDIF CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,ij_nb*dimsize, & MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter_unindexed_mpi_rgen VarOut",VarOut END SUBROUTINE orch_scatter_unindexed_mpi_rgen SUBROUTINE orch_scatter_unindexed_mpi_lgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(ij_nb,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts LOGICAL,DIMENSION(dimsize*iim_g*jjm_g) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter_unindexed_mpi_lgen VarIn",VarIn WRITE(numout,*) "orch_scatter_unindexed_mpi_lgen VarTmp",VarTmp ENDIF ENDIF CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,ij_nb*dimsize, & MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter_unindexed_mpi_lgen VarOut",VarOut END SUBROUTINE orch_scatter_unindexed_mpi_lgen SUBROUTINE orch_gather_unindexed_mpi_igen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp INTEGER(i_std),INTENT(IN),DIMENSION(ij_nb,dimsize) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts INTEGER(i_std),DIMENSION(dimsize*iim_g*jjm_g) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_igen ij_para_nb, displs, counts,Index_Para-1",& ij_para_nb, displs, counts,Index_Para-1 ENDIF CALL MPI_GATHERV(VarIn,ij_nb*dimsize,MPI_INT_ORCH,VarTmp,counts,displs, & MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) DO i=1,dimsize VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_igen VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) END SUBROUTINE orch_gather_unindexed_mpi_igen SUBROUTINE orch_gather_unindexed_mpi_rgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp REAL(r_std),INTENT(IN),DIMENSION(ij_nb,dimsize) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts REAL(r_std),DIMENSION(dimsize*iim_g*jjm_g) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_rgen ij_para_nb, displs, counts,Index_Para-1",& ij_para_nb, displs, counts,Index_Para-1 ENDIF IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_rgen VarIn=",VarIn CALL MPI_GATHERV(VarIn,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs, & MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) DO i=1,dimsize VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_rgen VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) END SUBROUTINE orch_gather_unindexed_mpi_rgen SUBROUTINE orch_gather_unindexed_mpi_lgen(VarIn, VarOut, nbp, dimsize) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp LOGICAL,INTENT(IN),DIMENSION(ij_nb,dimsize) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts LOGICAL,DIMENSION(dimsize*iim_g*jjm_g) :: VarTmp INTEGER(i_std) :: nb,i,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_lgen ij_para_nb, displs, counts,Index_Para-1",& ij_para_nb, displs, counts,Index_Para-1 ENDIF IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_lgen VarIn=",VarIn CALL MPI_GATHERV(VarIn,ij_nb*dimsize,MPI_LOGICAL,VarTmp,counts,displs, & MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) DO i=1,dimsize VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (check) & WRITE(numout,*) "orch_gather_unindexed_mpi_lgen VarOut=",VarOut IF (flag) CALL resume_timer(timer_mpi) END SUBROUTINE orch_gather_unindexed_mpi_lgen SUBROUTINE orch_scatter2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize) USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp2D INTEGER(i_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts INTEGER(i_std),DIMENSION(dimsize*iim*jjm) :: VarTmp1 INTEGER(i_std),DIMENSION(ij_nb,dimsize) :: VarTmp2 INTEGER(i_std) :: nb,i,ij,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter2D_mpi_igen VarIn",VarIn WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp1",VarTmp1 ENDIF ENDIF CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize, & MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp2",VarTmp2 DO i=1,dimsize DO ij=1,ij_nb VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i) ENDDO ENDDO IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter2D_mpi_igen VarOut",VarOut END SUBROUTINE orch_scatter2D_mpi_igen SUBROUTINE orch_scatter2D_mpi_rgen(VarIn, VarOut, nbp2D, dimsize) USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp2D REAL(r_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn REAL(r_std),INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts REAL(r_std),DIMENSION(dimsize*iim*jjm) :: VarTmp1 REAL(r_std),DIMENSION(ij_nb,dimsize) :: VarTmp2 INTEGER(i_std) :: nb,i,ij,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter2D_mpi_rgen VarIn",VarIn WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp1",VarTmp1 ENDIF ENDIF nb=ij_nb*dimsize IF (check) & WRITE(numout,*) "ij_nb*dimsize",ij_nb*dimsize CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_REAL_ORCH,VarTmp2,nb, & MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp2",VarTmp2 DO i=1,dimsize DO ij=1,ij_nb VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i) ENDDO ENDDO IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter2D_mpi_rgen VarOut",VarOut END SUBROUTINE orch_scatter2D_mpi_rgen SUBROUTINE orch_scatter2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize) USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp2D LOGICAL,INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn LOGICAL,INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts LOGICAL,DIMENSION(dimsize*iim*jjm) :: VarTmp1 LOGICAL,DIMENSION(ij_nb,dimsize) :: VarTmp2 INTEGER(i_std) :: nb,i,ij,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize DO i=1,dimsize VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i) Index_para=Index_para+nb ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_scatter2D_mpi_lgen VarIn",VarIn WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp1",VarTmp1 ENDIF ENDIF CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize, & MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp2",VarTmp2 DO i=1,dimsize DO ij=1,ij_nb VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i) ENDDO ENDDO IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_scatter2D_mpi_lgen VarOut",VarOut END SUBROUTINE orch_scatter2D_mpi_lgen SUBROUTINE orch_gather2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize) USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp2D INTEGER(i_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn INTEGER(i_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts INTEGER(i_std),DIMENSION(ij_nb,dimsize) :: VarTmp1 INTEGER(i_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2 INTEGER(i_std) :: nb,i,ij,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL,PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather2D_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1", & nbp_mpi_para, displs, counts,Index_Para-1 ENDIF DO i=1,dimsize DO ij=1,ij_nb VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i) ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_gather2D_mpi_igen VarIn=",VarIn WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp1=",VarTmp1 ENDIF CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs, & MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp2=",VarTmp2 IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) DO i=1,dimsize VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_gather2D_mpi_igen VarOut=",VarOut END SUBROUTINE orch_gather2D_mpi_igen SUBROUTINE orch_gather2D_mpi_rgen(VarIn, VarOut, nbp2D,dimsize) USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp2D REAL(r_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn REAL(r_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts REAL(r_std),DIMENSION(ij_nb,dimsize) :: VarTmp1 REAL(r_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2 INTEGER(i_std) :: nb,i,ij,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL,PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather2D_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1", & nbp_mpi_para, displs, counts,Index_Para-1 ENDIF DO i=1,dimsize DO ij=1,ij_nb VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i) ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_gather2D_mpi_rgen VarIn=",VarIn WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp1=",VarTmp1 ENDIF CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs, & MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp2=",VarTmp2 IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) DO i=1,dimsize VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_gather2D_mpi_rgen VarOut=",VarOut END SUBROUTINE orch_gather2D_mpi_rgen SUBROUTINE orch_gather2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize) USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g USE timer IMPLICIT NONE INTEGER(i_std),INTENT(IN) :: dimsize INTEGER(i_std),INTENT(IN) :: nbp2D LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn LOGICAL,INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut INCLUDE 'mpif.h' INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts LOGICAL,DIMENSION(ij_nb,dimsize) :: VarTmp1 LOGICAL,DIMENSION(dimsize*iim*jjm) :: VarTmp2 INTEGER(i_std) :: nb,i,ij,index_para,rank INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL,PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (flag) CALL suspend_timer(timer_mpi) IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) displs(rank)=Index_para-1 counts(rank)=nb*dimsize Index_para=Index_para+nb*dimsize ENDDO IF (check) & WRITE(numout,*) "orch_gather2D_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1", & nbp_mpi_para, displs, counts,Index_Para-1 ENDIF DO i=1,dimsize DO ij=1,ij_nb VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i) ENDDO ENDDO IF (check) THEN WRITE(numout,*) "orch_gather2D_mpi_lgen VarIn=",VarIn WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp1=",VarTmp1 ENDIF CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs, & MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr) IF (check) & WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp2=",VarTmp2 IF (is_mpi_root) THEN Index_para=1 DO rank=0,mpi_size-1 nb=ij_para_nb(rank) DO i=1,dimsize VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1) Index_para=Index_para+nb ENDDO ENDDO ENDIF IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_gather2D_mpi_lgen VarOut=",VarOut END SUBROUTINE orch_gather2D_mpi_lgen SUBROUTINE orch_reduce_sum_mpi_igen(VarIn,VarOut,nb) USE mod_orchidee_para_var USE timer IMPLICIT NONE INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut INTEGER(i_std),INTENT(IN) :: nb INCLUDE 'mpif.h' INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (check) & WRITE(numout,*) "orch_reduce_sum_mpi_igen VarIn",VarIn IF (flag) CALL suspend_timer(timer_mpi) CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_reduce_sum_mpi_igen VarOut",VarOut END SUBROUTINE orch_reduce_sum_mpi_igen SUBROUTINE orch_reduce_sum_mpi_rgen(VarIn,VarOut,nb) USE mod_orchidee_para_var USE timer IMPLICIT NONE REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut INTEGER(i_std),INTENT(IN) :: nb INCLUDE 'mpif.h' INTEGER(i_std) :: ierr LOGICAL :: flag=.FALSE. LOGICAL, PARAMETER :: check=.FALSE. IF (timer_state(timer_mpi)==running) THEN flag=.TRUE. ELSE flag=.FALSE. ENDIF IF (check) & WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarIn",VarIn IF (flag) CALL suspend_timer(timer_mpi) CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr) IF (flag) CALL resume_timer(timer_mpi) IF (check) & WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarOut",VarOut END SUBROUTINE orch_reduce_sum_mpi_rgen #endif