Index: LMDZ6/trunk/libf/phy_common/abort_physic.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/abort_physic.F90 (revision 5267) +++ (revision ) @@ -1,51 +1,0 @@ -! $Id: $ - SUBROUTINE abort_physic(modname, message, ierr) - - USE IOIPSL - - USE mod_phys_lmdz_para - USE print_control_mod, ONLY: lunout - IMPLICIT NONE -! -! Stops the simulation cleanly, closing files and printing various -! comments -! -! Input: modname = name of calling program -! message = stuff to print -! ierr = severity of situation ( = 0 normal ) - - character(len=*), intent(in):: modname - integer ierr, ierror_mpi - character(len=*), intent(in):: message - - write(lunout,*) 'in abort_physic' -!$OMP MASTER - call histclo - call restclo - if (mpi_rank .eq. 0) then - call getin_dump - endif -!$OMP END MASTER - - write(lunout,*) 'Stopping in ', modname - write(lunout,*) 'Reason = ',message - if (ierr .eq. 0) then - write(lunout,*) 'Everything is cool' - if (using_mpi) then - !$OMP CRITICAL (MPI_ABORT_PHYSIC) - call MPI_ABORT(COMM_LMDZ_PHY, 0, ierror_mpi) - !$OMP END CRITICAL (MPI_ABORT_PHYSIC) - else - stop 0 - endif - else - write(lunout,*) 'Houston, we have a problem, ierr = ', ierr - if (using_mpi) then - !$OMP CRITICAL (MPI_ABORT_PHYSIC) - call MPI_ABORT(COMM_LMDZ_PHY, 1, ierror_mpi) - !$OMP END CRITICAL (MPI_ABORT_PHYSIC) - else - stop 1 - endif - endif - END Index: LMDZ6/trunk/libf/phy_common/abort_physic.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/abort_physic.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/abort_physic.f90 (revision 5268) @@ -0,0 +1,51 @@ +! $Id: $ + SUBROUTINE abort_physic(modname, message, ierr) + + USE IOIPSL + + USE mod_phys_lmdz_para + USE print_control_mod, ONLY: lunout + IMPLICIT NONE +! +! Stops the simulation cleanly, closing files and printing various +! comments +! +! Input: modname = name of calling program +! message = stuff to print +! ierr = severity of situation ( = 0 normal ) + + character(len=*), intent(in):: modname + integer ierr, ierror_mpi + character(len=*), intent(in):: message + + write(lunout,*) 'in abort_physic' +!$OMP MASTER + call histclo + call restclo + if (mpi_rank .eq. 0) then + call getin_dump + endif +!$OMP END MASTER + + write(lunout,*) 'Stopping in ', modname + write(lunout,*) 'Reason = ',message + if (ierr .eq. 0) then + write(lunout,*) 'Everything is cool' + if (using_mpi) then + !$OMP CRITICAL (MPI_ABORT_PHYSIC) + call MPI_ABORT(COMM_LMDZ_PHY, 0, ierror_mpi) + !$OMP END CRITICAL (MPI_ABORT_PHYSIC) + else + stop 0 + endif + else + write(lunout,*) 'Houston, we have a problem, ierr = ', ierr + if (using_mpi) then + !$OMP CRITICAL (MPI_ABORT_PHYSIC) + call MPI_ABORT(COMM_LMDZ_PHY, 1, ierror_mpi) + !$OMP END CRITICAL (MPI_ABORT_PHYSIC) + else + stop 1 + endif + endif + END Index: LMDZ6/trunk/libf/phy_common/geometry_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/geometry_mod.F90 (revision 5267) +++ (revision ) @@ -1,79 +1,0 @@ -MODULE geometry_mod - -! Store informations concerning the local (to MPI/OpenMP core) geometry - - REAL,SAVE,ALLOCATABLE :: longitude(:) ! longitude of the cell (rad) -!$OMP THREADPRIVATE(longitude) - - REAL,SAVE,ALLOCATABLE :: latitude(:)! latitude of the cell (rad) -!$OMP THREADPRIVATE(latitude) - - REAL,SAVE,ALLOCATABLE :: longitude_deg(:) ! longitude of the cell (degree) -!$OMP THREADPRIVATE(longitude_deg) - - REAL,SAVE,ALLOCATABLE :: latitude_deg(:)! latitude of the cell (degree) -!$OMP THREADPRIVATE(latitude_deg) - - REAL,SAVE,ALLOCATABLE :: boundslon(:,:) ! boundaries of the cell (rad) -!$OMP THREADPRIVATE(boundslon) - - REAL,SAVE,ALLOCATABLE :: boundslat(:,:) ! boundaries of the cell (rad) -!$OMP THREADPRIVATE(boundslat) - - REAL,SAVE,ALLOCATABLE :: dx(:) ! resolution of longitude cell (valid only for 2D grid) -!$OMP THREADPRIVATE(dx) - - REAL,SAVE,ALLOCATABLE :: dy(:) ! resolution of latitude cell (valid only for 2D grid) -!$OMP THREADPRIVATE(dy) - - REAL,SAVE,ALLOCATABLE :: cell_area(:) ! area of the cell -!$OMP THREADPRIVATE(cell_area) - - INTEGER,SAVE,ALLOCATABLE :: ind_cell_glo(:) ! global indice of a local cell -!$OMP THREADPRIVATE(ind_cell_glo) - -CONTAINS - - SUBROUTINE init_geometry(klon,longitude_,latitude_, & - boundslon_,boundslat_, & - cell_area_,ind_cell_glo_,dx_,dy_) - USE mod_grid_phy_lmdz, ONLY: nvertex - USE nrtype, ONLY : PI - IMPLICIT NONE - INTEGER,INTENT(IN) :: klon ! number of columns for this MPI/OpenMP domain - REAL,INTENT(IN) :: longitude_(klon) - REAL,INTENT(IN) :: latitude_(klon) - REAL,INTENT(IN) :: boundslon_(klon,nvertex) - REAL,INTENT(IN) :: boundslat_(klon,nvertex) - REAL,INTENT(IN) :: cell_area_(klon) - INTEGER,OPTIONAL,INTENT(IN) :: ind_cell_glo_(klon) - REAL,OPTIONAL,INTENT(IN) :: dx_(klon) - REAL,OPTIONAL,INTENT(IN) :: dy_(klon) - - ALLOCATE(longitude(klon)) - ALLOCATE(latitude(klon)) - ALLOCATE(longitude_deg(klon)) - ALLOCATE(latitude_deg(klon)) - ALLOCATE(boundslon(klon,nvertex)) - ALLOCATE(boundslat(klon,nvertex)) - ALLOCATE(cell_area(klon)) - IF (PRESENT(ind_cell_glo_)) ALLOCATE(ind_cell_glo(klon)) - IF (PRESENT(dx_)) ALLOCATE(dx(klon)) - IF (PRESENT(dy_))ALLOCATE(dy(klon)) - - longitude(:) = longitude_(:) - latitude(:) = latitude_(:) - longitude_deg(:) = longitude(:)*180./PI - latitude_deg(:) = latitude(:)*180./PI - boundslon(:,:) = boundslon_(:,:) - boundslat(:,:) = boundslat_(:,:) - cell_area(:) = cell_area_(:) - IF (PRESENT(ind_cell_glo_)) ind_cell_glo(:) = ind_cell_glo_(:) - IF (PRESENT(dx_)) dx(:) = dx_(:) - IF (PRESENT(dy_)) dy(:) = dy_(:) - - END SUBROUTINE init_geometry - - -END MODULE geometry_mod - Index: LMDZ6/trunk/libf/phy_common/geometry_mod.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/geometry_mod.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/geometry_mod.f90 (revision 5268) @@ -0,0 +1,79 @@ +MODULE geometry_mod + +! Store informations concerning the local (to MPI/OpenMP core) geometry + + REAL,SAVE,ALLOCATABLE :: longitude(:) ! longitude of the cell (rad) +!$OMP THREADPRIVATE(longitude) + + REAL,SAVE,ALLOCATABLE :: latitude(:)! latitude of the cell (rad) +!$OMP THREADPRIVATE(latitude) + + REAL,SAVE,ALLOCATABLE :: longitude_deg(:) ! longitude of the cell (degree) +!$OMP THREADPRIVATE(longitude_deg) + + REAL,SAVE,ALLOCATABLE :: latitude_deg(:)! latitude of the cell (degree) +!$OMP THREADPRIVATE(latitude_deg) + + REAL,SAVE,ALLOCATABLE :: boundslon(:,:) ! boundaries of the cell (rad) +!$OMP THREADPRIVATE(boundslon) + + REAL,SAVE,ALLOCATABLE :: boundslat(:,:) ! boundaries of the cell (rad) +!$OMP THREADPRIVATE(boundslat) + + REAL,SAVE,ALLOCATABLE :: dx(:) ! resolution of longitude cell (valid only for 2D grid) +!$OMP THREADPRIVATE(dx) + + REAL,SAVE,ALLOCATABLE :: dy(:) ! resolution of latitude cell (valid only for 2D grid) +!$OMP THREADPRIVATE(dy) + + REAL,SAVE,ALLOCATABLE :: cell_area(:) ! area of the cell +!$OMP THREADPRIVATE(cell_area) + + INTEGER,SAVE,ALLOCATABLE :: ind_cell_glo(:) ! global indice of a local cell +!$OMP THREADPRIVATE(ind_cell_glo) + +CONTAINS + + SUBROUTINE init_geometry(klon,longitude_,latitude_, & + boundslon_,boundslat_, & + cell_area_,ind_cell_glo_,dx_,dy_) + USE mod_grid_phy_lmdz, ONLY: nvertex + USE nrtype, ONLY : PI + IMPLICIT NONE + INTEGER,INTENT(IN) :: klon ! number of columns for this MPI/OpenMP domain + REAL,INTENT(IN) :: longitude_(klon) + REAL,INTENT(IN) :: latitude_(klon) + REAL,INTENT(IN) :: boundslon_(klon,nvertex) + REAL,INTENT(IN) :: boundslat_(klon,nvertex) + REAL,INTENT(IN) :: cell_area_(klon) + INTEGER,OPTIONAL,INTENT(IN) :: ind_cell_glo_(klon) + REAL,OPTIONAL,INTENT(IN) :: dx_(klon) + REAL,OPTIONAL,INTENT(IN) :: dy_(klon) + + ALLOCATE(longitude(klon)) + ALLOCATE(latitude(klon)) + ALLOCATE(longitude_deg(klon)) + ALLOCATE(latitude_deg(klon)) + ALLOCATE(boundslon(klon,nvertex)) + ALLOCATE(boundslat(klon,nvertex)) + ALLOCATE(cell_area(klon)) + IF (PRESENT(ind_cell_glo_)) ALLOCATE(ind_cell_glo(klon)) + IF (PRESENT(dx_)) ALLOCATE(dx(klon)) + IF (PRESENT(dy_))ALLOCATE(dy(klon)) + + longitude(:) = longitude_(:) + latitude(:) = latitude_(:) + longitude_deg(:) = longitude(:)*180./PI + latitude_deg(:) = latitude(:)*180./PI + boundslon(:,:) = boundslon_(:,:) + boundslat(:,:) = boundslat_(:,:) + cell_area(:) = cell_area_(:) + IF (PRESENT(ind_cell_glo_)) ind_cell_glo(:) = ind_cell_glo_(:) + IF (PRESENT(dx_)) dx(:) = dx_(:) + IF (PRESENT(dy_)) dy(:) = dy_(:) + + END SUBROUTINE init_geometry + + +END MODULE geometry_mod + Index: LMDZ6/trunk/libf/phy_common/init_print_control_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/init_print_control_mod.F90 (revision 5267) +++ (revision ) @@ -1,67 +1,0 @@ -MODULE init_print_control_mod - -! init_print_control to initialize print_control_mod variables -! not included there because of circular dependecy issues - -CONTAINS - - SUBROUTINE init_print_control - USE print_control_mod, ONLY : set_print_control - USE ioipsl_getin_p_mod, ONLY : getin_p - USE mod_phys_lmdz_para, ONLY: is_omp_root, is_master - IMPLICIT NONE - - INTEGER :: lunout ! default output file identifier (6==screen) - INTEGER :: prt_level ! Output level - LOGICAL :: debug ! flag to specify if in "debug mode" - LOGICAL :: opened - INTEGER :: number - - !Config Key = prt_level - !Config Desc = niveau d'impressions de débogage - !Config Def = 0 - !Config Help = Niveau d'impression pour le débogage - !Config (0 = minimum d'impression) - prt_level = 0 - CALL getin_p('prt_level',prt_level) - - !Config Key = lunout - !Config Desc = unite de fichier pour les impressions - !Config Def = 6 - !Config Help = unite de fichier pour les impressions - !Config (defaut sortie standard = 6) - lunout=6 - CALL getin_p('lunout', lunout) - - IF (is_omp_root) THEN - IF (lunout /= 5 .and. lunout /= 6) THEN - INQUIRE(FILE='lmdz.out_0000',OPENED=opened,NUMBER=number) - IF (opened) THEN - lunout=number - ELSE - OPEN(UNIT=lunout,FILE='lmdz.out_0000',ACTION='write', & - STATUS='unknown',FORM='formatted') - ENDIF - ENDIF - ENDIF - - !Config Key = debug - !Config Desc = mode debogage - !Config Def = false - !Config Help = positionne le mode debogage - - debug = .FALSE. - CALL getin_p('debug',debug) - - IF (is_master) THEN - WRITE(lunout,*)"init_print_control: prt_level=",prt_level - WRITE(lunout,*)"init_print_control: lunout=",lunout - WRITE(lunout,*)"init_print_control: debug=",debug - ENDIF - - CALL set_print_control(lunout,prt_level,debug) - - END SUBROUTINE init_print_control - -END MODULE init_print_control_mod - Index: LMDZ6/trunk/libf/phy_common/init_print_control_mod.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/init_print_control_mod.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/init_print_control_mod.f90 (revision 5268) @@ -0,0 +1,67 @@ +MODULE init_print_control_mod + +! init_print_control to initialize print_control_mod variables +! not included there because of circular dependecy issues + +CONTAINS + + SUBROUTINE init_print_control + USE print_control_mod, ONLY : set_print_control + USE ioipsl_getin_p_mod, ONLY : getin_p + USE mod_phys_lmdz_para, ONLY: is_omp_root, is_master + IMPLICIT NONE + + INTEGER :: lunout ! default output file identifier (6==screen) + INTEGER :: prt_level ! Output level + LOGICAL :: debug ! flag to specify if in "debug mode" + LOGICAL :: opened + INTEGER :: number + + !Config Key = prt_level + !Config Desc = niveau d'impressions de débogage + !Config Def = 0 + !Config Help = Niveau d'impression pour le débogage + !Config (0 = minimum d'impression) + prt_level = 0 + CALL getin_p('prt_level',prt_level) + + !Config Key = lunout + !Config Desc = unite de fichier pour les impressions + !Config Def = 6 + !Config Help = unite de fichier pour les impressions + !Config (defaut sortie standard = 6) + lunout=6 + CALL getin_p('lunout', lunout) + + IF (is_omp_root) THEN + IF (lunout /= 5 .and. lunout /= 6) THEN + INQUIRE(FILE='lmdz.out_0000',OPENED=opened,NUMBER=number) + IF (opened) THEN + lunout=number + ELSE + OPEN(UNIT=lunout,FILE='lmdz.out_0000',ACTION='write', & + STATUS='unknown',FORM='formatted') + ENDIF + ENDIF + ENDIF + + !Config Key = debug + !Config Desc = mode debogage + !Config Def = false + !Config Help = positionne le mode debogage + + debug = .FALSE. + CALL getin_p('debug',debug) + + IF (is_master) THEN + WRITE(lunout,*)"init_print_control: prt_level=",prt_level + WRITE(lunout,*)"init_print_control: lunout=",lunout + WRITE(lunout,*)"init_print_control: debug=",debug + ENDIF + + CALL set_print_control(lunout,prt_level,debug) + + END SUBROUTINE init_print_control + +END MODULE init_print_control_mod + Index: LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.F90 (revision 5267) +++ (revision ) @@ -1,165 +1,0 @@ -! -! $Id$ -! -MODULE ioipsl_getin_p_mod -! To use getin in a parallel context -!--------------------------------------------------------------------- -USE ioipsl, ONLY: getin -USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root -USE mod_phys_lmdz_omp_data, ONLY : is_omp_root -USE mod_phys_lmdz_transfert_para, ONLY : bcast -!- -IMPLICIT NONE -!- -PRIVATE -PUBLIC :: getin_p -!- -INTERFACE getin_p - - MODULE PROCEDURE getinrs_p, getinr1d_p, getinr2d_p, & - & getinis_p, getini1d_p, getini2d_p, & - & getincs_p, & - & getinls_p, getinl1d_p, getinl2d_p -END INTERFACE -!- -CONTAINS - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des getin -> bcast !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! -- Les chaines de caracteres -- !! - - SUBROUTINE getincs_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - CHARACTER(LEN=*),INTENT(INOUT) :: VarOut - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getincs_p - -!! -- Les entiers -- !! - - SUBROUTINE getinis_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - INTEGER,INTENT(INOUT) :: VarOut - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getinis_p - - SUBROUTINE getini1d_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - INTEGER,INTENT(INOUT) :: VarOut(:) - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getini1d_p - - SUBROUTINE getini2d_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - INTEGER,INTENT(INOUT) :: VarOut(:,:) - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getini2d_p - -!! -- Les flottants -- !! - - SUBROUTINE getinrs_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - REAL,INTENT(INOUT) :: VarOut - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getinrs_p - - SUBROUTINE getinr1d_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - REAL,INTENT(INOUT) :: VarOut(:) - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getinr1d_p - - SUBROUTINE getinr2d_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - REAL,INTENT(INOUT) :: VarOut(:,:) - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getinr2d_p - -!! -- Les Booleens -- !! - - SUBROUTINE getinls_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - LOGICAL,INTENT(INOUT) :: VarOut - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getinls_p - - SUBROUTINE getinl1d_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - LOGICAL,INTENT(INOUT) :: VarOut(:) - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getinl1d_p - - SUBROUTINE getinl2d_p(VarIn,VarOut) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(IN) :: VarIn - LOGICAL,INTENT(INOUT) :: VarOut(:,:) - -!$OMP BARRIER - IF (is_mpi_root .AND. is_omp_root) THEN - CALL getin(VarIn,VarOut) - ENDIF - CALL bcast(VarOut) - END SUBROUTINE getinl2d_p -!- -!----------------------------- -!----------------------------- -!----------------------------- - -END MODULE ioipsl_getin_p_mod - Index: LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.f90 (revision 5268) @@ -0,0 +1,165 @@ +! +! $Id$ +! +MODULE ioipsl_getin_p_mod +! To use getin in a parallel context +!--------------------------------------------------------------------- +USE ioipsl, ONLY: getin +USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root +USE mod_phys_lmdz_omp_data, ONLY : is_omp_root +USE mod_phys_lmdz_transfert_para, ONLY : bcast +!- +IMPLICIT NONE +!- +PRIVATE +PUBLIC :: getin_p +!- +INTERFACE getin_p + + MODULE PROCEDURE getinrs_p, getinr1d_p, getinr2d_p, & + & getinis_p, getini1d_p, getini2d_p, & + & getincs_p, & + & getinls_p, getinl1d_p, getinl2d_p +END INTERFACE +!- +CONTAINS + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des getin -> bcast !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! -- Les chaines de caracteres -- !! + + SUBROUTINE getincs_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + CHARACTER(LEN=*),INTENT(INOUT) :: VarOut + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getincs_p + +!! -- Les entiers -- !! + + SUBROUTINE getinis_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + INTEGER,INTENT(INOUT) :: VarOut + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getinis_p + + SUBROUTINE getini1d_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + INTEGER,INTENT(INOUT) :: VarOut(:) + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getini1d_p + + SUBROUTINE getini2d_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + INTEGER,INTENT(INOUT) :: VarOut(:,:) + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getini2d_p + +!! -- Les flottants -- !! + + SUBROUTINE getinrs_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + REAL,INTENT(INOUT) :: VarOut + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getinrs_p + + SUBROUTINE getinr1d_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + REAL,INTENT(INOUT) :: VarOut(:) + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getinr1d_p + + SUBROUTINE getinr2d_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + REAL,INTENT(INOUT) :: VarOut(:,:) + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getinr2d_p + +!! -- Les Booleens -- !! + + SUBROUTINE getinls_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + LOGICAL,INTENT(INOUT) :: VarOut + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getinls_p + + SUBROUTINE getinl1d_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + LOGICAL,INTENT(INOUT) :: VarOut(:) + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getinl1d_p + + SUBROUTINE getinl2d_p(VarIn,VarOut) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: VarIn + LOGICAL,INTENT(INOUT) :: VarOut(:,:) + +!$OMP BARRIER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL getin(VarIn,VarOut) + ENDIF + CALL bcast(VarOut) + END SUBROUTINE getinl2d_p +!- +!----------------------------- +!----------------------------- +!----------------------------- + +END MODULE ioipsl_getin_p_mod + Index: LMDZ6/trunk/libf/phy_common/mod_grid_phy_lmdz.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_grid_phy_lmdz.F90 (revision 5267) +++ (revision ) @@ -1,468 +1,0 @@ -! -!$Id $ -! -MODULE mod_grid_phy_lmdz - - PUBLIC - PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, & - grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen - - INTEGER,PARAMETER :: unstructured=0 - INTEGER,PARAMETER :: regular_lonlat=1 - - INTEGER,SAVE :: grid_type - INTEGER,SAVE :: nvertex - INTEGER,SAVE :: nbp_lon ! == iim - INTEGER,SAVE :: nbp_lat ! == jjmp1 (or == 1 if running 1D model) - INTEGER,SAVE :: nbp_lev ! == llm - INTEGER,SAVE :: klon_glo ! total number of atmospheric columns - - INTERFACE grid1dTo2d_glo - MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, & - grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, & - grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3 - END INTERFACE - - INTERFACE grid2dTo1d_glo - MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, & - grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, & - grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3 - END INTERFACE - -CONTAINS - -!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! SUBROUTINE grid1dTo2d !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - SUBROUTINE init_grid_phy_lmdz(grid_type_,nvertex_,nbp_lon_,nbp_lat_,nbp_lev_) - IMPLICIT NONE - INTEGER,INTENT(IN) :: grid_type_ - INTEGER,INTENT(IN) :: nvertex_ - INTEGER, INTENT(IN) :: nbp_lon_ - INTEGER, INTENT(IN) :: nbp_lat_ - INTEGER, INTENT(IN) :: nbp_lev_ - - grid_type = grid_type_ - nvertex = nvertex_ - nbp_lon = nbp_lon_ - nbp_lat = nbp_lat_ - nbp_lev = nbp_lev_ - - IF (nbp_lon*nbp_lat==1) THEN - klon_glo=1 - ELSE - klon_glo=(nbp_lon*nbp_lat)-2*(nbp_lon-1) - ENDIF - - END SUBROUTINE init_grid_phy_lmdz - - - SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid1dTo2d_glo_igen(VarIn,VarOut,1) - - END SUBROUTINE grid1dTo2d_glo_i - - - SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)) - - END SUBROUTINE grid1dTo2d_glo_i1 - - SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) - - END SUBROUTINE grid1dTo2d_glo_i2 - - SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid1dTo2d_glo_i3 - - - SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1) - - END SUBROUTINE grid1dTo2d_glo_r - - - SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)) - - END SUBROUTINE grid1dTo2d_glo_r1 - - SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) - - END SUBROUTINE grid1dTo2d_glo_r2 - - SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid1dTo2d_glo_r3 - - - - SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1) - - END SUBROUTINE grid1dTo2d_glo_l - - - SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)) - - END SUBROUTINE grid1dTo2d_glo_l1 - - SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) - - END SUBROUTINE grid1dTo2d_glo_l2 - - SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid1dTo2d_glo_l3 - - SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL grid2dTo1d_glo_igen(VarIn,VarOut,1) - - END SUBROUTINE grid2dTo1d_glo_i - - - SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)) - - END SUBROUTINE grid2dTo1d_glo_i1 - - SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid2dTo1d_glo_i2 - - SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) - - END SUBROUTINE grid2dTo1d_glo_i3 - - - - - SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1) - - END SUBROUTINE grid2dTo1d_glo_r - - - SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)) - - END SUBROUTINE grid2dTo1d_glo_r1 - - SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid2dTo1d_glo_r2 - - SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) - - END SUBROUTINE grid2dTo1d_glo_r3 - - - - SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1) - - END SUBROUTINE grid2dTo1d_glo_l - - - SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)) - - END SUBROUTINE grid2dTo1d_glo_l1 - - SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid2dTo1d_glo_l2 - - SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) - - END SUBROUTINE grid2dTo1d_glo_l3 - -!---------------------------------------------------------------- -! Generic (private) fonctions -!---------------------------------------------------------------- - - SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize) - - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarOut - INTEGER :: i,ij,Offset - - - Offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_glo - VarOut(ij+offset-1,i)=VarIn(ij,i) - ENDDO - ENDDO - - - DO i=1,dimsize - DO ij=1,nbp_lon - VarOut(ij,i)=VarIn(1,i) - ENDDO - ENDDO - - - DO i=1,dimsize - DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon - VarOut(ij,i)=VarIn(klon_glo,i) - ENDDO - ENDDO - - END SUBROUTINE grid1dTo2d_glo_igen - - - SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize) - - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarOut - INTEGER :: i,ij,Offset - - - Offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_glo - VarOut(ij+offset-1,i)=VarIn(ij,i) - ENDDO - ENDDO - - - DO i=1,dimsize - DO ij=1,nbp_lon - VarOut(ij,i)=VarIn(1,i) - ENDDO - ENDDO - - - DO i=1,dimsize - DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon - VarOut(ij,i)=VarIn(klon_glo,i) - ENDDO - ENDDO - - END SUBROUTINE grid1dTo2d_glo_rgen - - SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize) - - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarOut - INTEGER :: i,ij,Offset - - Offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_glo - VarOut(ij+offset-1,i)=VarIn(ij,i) - ENDDO - ENDDO - - - DO i=1,dimsize - DO ij=1,nbp_lon - VarOut(ij,i)=VarIn(1,i) - ENDDO - ENDDO - - - DO i=1,dimsize - DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon - VarOut(ij,i)=VarIn(klon_glo,i) - ENDDO - ENDDO - - END SUBROUTINE grid1dTo2d_glo_lgen - - - SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize) - - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut - INTEGER :: i,ij,offset - - offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_glo - VarOut(ij,i)=VarIn(ij+offset-1,i) - ENDDO - ENDDO - - DO i=1,dimsize - VarOut(1,i)=VarIn(1,i) - ENDDO - - END SUBROUTINE grid2dTo1d_glo_igen - - SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize) - - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut - INTEGER :: i,ij,offset - - offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_glo - VarOut(ij,i)=VarIn(ij+offset-1,i) - ENDDO - ENDDO - - DO i=1,dimsize - VarOut(1,i)=VarIn(1,i) - ENDDO - - END SUBROUTINE grid2dTo1d_glo_rgen - - SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize) - - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut - INTEGER :: i,ij,offset - - offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_glo - VarOut(ij,i)=VarIn(ij+offset-1,i) - ENDDO - ENDDO - - DO i=1,dimsize - VarOut(1,i)=VarIn(1,i) - ENDDO - - END SUBROUTINE grid2dTo1d_glo_lgen - -END MODULE mod_grid_phy_lmdz Index: LMDZ6/trunk/libf/phy_common/mod_grid_phy_lmdz.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_grid_phy_lmdz.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/mod_grid_phy_lmdz.f90 (revision 5268) @@ -0,0 +1,468 @@ +! +!$Id $ +! +MODULE mod_grid_phy_lmdz + + PUBLIC + PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, & + grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen + + INTEGER,PARAMETER :: unstructured=0 + INTEGER,PARAMETER :: regular_lonlat=1 + + INTEGER,SAVE :: grid_type + INTEGER,SAVE :: nvertex + INTEGER,SAVE :: nbp_lon ! == iim + INTEGER,SAVE :: nbp_lat ! == jjmp1 (or == 1 if running 1D model) + INTEGER,SAVE :: nbp_lev ! == llm + INTEGER,SAVE :: klon_glo ! total number of atmospheric columns + + INTERFACE grid1dTo2d_glo + MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, & + grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, & + grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3 + END INTERFACE + + INTERFACE grid2dTo1d_glo + MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, & + grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, & + grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3 + END INTERFACE + +CONTAINS + +!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! SUBROUTINE grid1dTo2d !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + SUBROUTINE init_grid_phy_lmdz(grid_type_,nvertex_,nbp_lon_,nbp_lat_,nbp_lev_) + IMPLICIT NONE + INTEGER,INTENT(IN) :: grid_type_ + INTEGER,INTENT(IN) :: nvertex_ + INTEGER, INTENT(IN) :: nbp_lon_ + INTEGER, INTENT(IN) :: nbp_lat_ + INTEGER, INTENT(IN) :: nbp_lev_ + + grid_type = grid_type_ + nvertex = nvertex_ + nbp_lon = nbp_lon_ + nbp_lat = nbp_lat_ + nbp_lev = nbp_lev_ + + IF (nbp_lon*nbp_lat==1) THEN + klon_glo=1 + ELSE + klon_glo=(nbp_lon*nbp_lat)-2*(nbp_lon-1) + ENDIF + + END SUBROUTINE init_grid_phy_lmdz + + + SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid1dTo2d_glo_igen(VarIn,VarOut,1) + + END SUBROUTINE grid1dTo2d_glo_i + + + SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)) + + END SUBROUTINE grid1dTo2d_glo_i1 + + SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) + + END SUBROUTINE grid1dTo2d_glo_i2 + + SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid1dTo2d_glo_i3 + + + SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1) + + END SUBROUTINE grid1dTo2d_glo_r + + + SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)) + + END SUBROUTINE grid1dTo2d_glo_r1 + + SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) + + END SUBROUTINE grid1dTo2d_glo_r2 + + SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid1dTo2d_glo_r3 + + + + SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1) + + END SUBROUTINE grid1dTo2d_glo_l + + + SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)) + + END SUBROUTINE grid1dTo2d_glo_l1 + + SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) + + END SUBROUTINE grid1dTo2d_glo_l2 + + SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid1dTo2d_glo_l3 + + SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL grid2dTo1d_glo_igen(VarIn,VarOut,1) + + END SUBROUTINE grid2dTo1d_glo_i + + + SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)) + + END SUBROUTINE grid2dTo1d_glo_i1 + + SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid2dTo1d_glo_i2 + + SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) + + END SUBROUTINE grid2dTo1d_glo_i3 + + + + + SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1) + + END SUBROUTINE grid2dTo1d_glo_r + + + SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)) + + END SUBROUTINE grid2dTo1d_glo_r1 + + SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid2dTo1d_glo_r2 + + SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) + + END SUBROUTINE grid2dTo1d_glo_r3 + + + + SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1) + + END SUBROUTINE grid2dTo1d_glo_l + + + SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)) + + END SUBROUTINE grid2dTo1d_glo_l1 + + SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid2dTo1d_glo_l2 + + SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) + + END SUBROUTINE grid2dTo1d_glo_l3 + +!---------------------------------------------------------------- +! Generic (private) fonctions +!---------------------------------------------------------------- + + SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize) + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarOut + INTEGER :: i,ij,Offset + + + Offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_glo + VarOut(ij+offset-1,i)=VarIn(ij,i) + ENDDO + ENDDO + + + DO i=1,dimsize + DO ij=1,nbp_lon + VarOut(ij,i)=VarIn(1,i) + ENDDO + ENDDO + + + DO i=1,dimsize + DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon + VarOut(ij,i)=VarIn(klon_glo,i) + ENDDO + ENDDO + + END SUBROUTINE grid1dTo2d_glo_igen + + + SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize) + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarOut + INTEGER :: i,ij,Offset + + + Offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_glo + VarOut(ij+offset-1,i)=VarIn(ij,i) + ENDDO + ENDDO + + + DO i=1,dimsize + DO ij=1,nbp_lon + VarOut(ij,i)=VarIn(1,i) + ENDDO + ENDDO + + + DO i=1,dimsize + DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon + VarOut(ij,i)=VarIn(klon_glo,i) + ENDDO + ENDDO + + END SUBROUTINE grid1dTo2d_glo_rgen + + SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize) + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarOut + INTEGER :: i,ij,Offset + + Offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_glo + VarOut(ij+offset-1,i)=VarIn(ij,i) + ENDDO + ENDDO + + + DO i=1,dimsize + DO ij=1,nbp_lon + VarOut(ij,i)=VarIn(1,i) + ENDDO + ENDDO + + + DO i=1,dimsize + DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon + VarOut(ij,i)=VarIn(klon_glo,i) + ENDDO + ENDDO + + END SUBROUTINE grid1dTo2d_glo_lgen + + + SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize) + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut + INTEGER :: i,ij,offset + + offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_glo + VarOut(ij,i)=VarIn(ij+offset-1,i) + ENDDO + ENDDO + + DO i=1,dimsize + VarOut(1,i)=VarIn(1,i) + ENDDO + + END SUBROUTINE grid2dTo1d_glo_igen + + SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize) + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut + INTEGER :: i,ij,offset + + offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_glo + VarOut(ij,i)=VarIn(ij+offset-1,i) + ENDDO + ENDDO + + DO i=1,dimsize + VarOut(1,i)=VarIn(1,i) + ENDDO + + END SUBROUTINE grid2dTo1d_glo_rgen + + SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize) + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut + INTEGER :: i,ij,offset + + offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_glo + VarOut(ij,i)=VarIn(ij+offset-1,i) + ENDDO + ENDDO + + DO i=1,dimsize + VarOut(1,i)=VarIn(1,i) + ENDDO + + END SUBROUTINE grid2dTo1d_glo_lgen + +END MODULE mod_grid_phy_lmdz Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_data.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_data.F90 (revision 5267) +++ (revision ) @@ -1,222 +1,0 @@ -! -!$Id$ -! -MODULE mod_phys_lmdz_mpi_data - USE lmdz_mpi - USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA - - INTEGER,SAVE :: ii_begin - INTEGER,SAVE :: ii_end - INTEGER,SAVE :: jj_begin - INTEGER,SAVE :: jj_end - INTEGER,SAVE :: jj_nb - INTEGER,SAVE :: ij_begin - INTEGER,SAVE :: ij_end - INTEGER,SAVE :: ij_nb - INTEGER,SAVE :: klon_mpi_begin - INTEGER,SAVE :: klon_mpi_end - INTEGER,SAVE :: klon_mpi - - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end - - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end - - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end - - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end - - - INTEGER,SAVE :: mpi_rank - INTEGER,SAVE :: mpi_size - INTEGER,SAVE :: mpi_master - LOGICAL,SAVE :: is_mpi_root - LOGICAL,SAVE :: is_using_mpi - - - LOGICAL,SAVE :: is_north_pole_dyn - LOGICAL,SAVE :: is_south_pole_dyn - INTEGER,SAVE :: COMM_LMDZ_PHY - INTEGER,SAVE :: MPI_REAL_LMDZ ! MPI_REAL8 - -CONTAINS - - SUBROUTINE init_phys_lmdz_mpi_data(nbp, nbp_lon, nbp_lat, nbp_lev, grid_type, nvertex, communicator) - USE lmdz_mpi - IMPLICIT NONE - INTEGER,INTENT(IN) :: nbp - INTEGER,INTENT(IN) :: nbp_lon - INTEGER,INTENT(IN) :: nbp_lat - INTEGER,INTENT(IN) :: nbp_lev - INTEGER,INTENT(IN) :: communicator - INTEGER,INTENT(IN) :: grid_type - INTEGER,INTENT(IN) :: nvertex - - INTEGER,ALLOCATABLE :: distrib(:) - INTEGER :: ierr - INTEGER :: klon_glo - INTEGER :: i - - is_using_mpi = using_mpi - - if ((nbp_lon.eq.1).and.(nbp_lat.eq.1)) then ! running 1D column model - klon_glo=1 - else - ! The usual global physics grid: 1 point for each pole and nbp_lon points - ! for all other latitudes - klon_glo=nbp_lon*(nbp_lat-2)+2 - endif - - COMM_LMDZ_PHY=communicator - - IF (is_using_mpi) THEN - MPI_REAL_LMDZ=MPI_REAL8 - CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr) - CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr) - ELSE - mpi_size=1 - mpi_rank=0 - ENDIF - - ALLOCATE(distrib(0:mpi_size-1)) - - IF (is_using_mpi) THEN - CALL MPI_ALLGATHER(nbp,1,MPI_INTEGER,distrib,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr) - ELSE - distrib(:)=nbp - ENDIF - - - IF (mpi_rank == 0) THEN - mpi_master = 0 - is_mpi_root = .true. - ENDIF - - IF (mpi_rank == 0) THEN - is_north_pole_dyn = .TRUE. - ELSE - is_north_pole_dyn = .FALSE. - ENDIF - - IF (mpi_rank == mpi_size-1) THEN - is_south_pole_dyn = .TRUE. - ELSE - is_south_pole_dyn = .FALSE. - ENDIF - - ALLOCATE(jj_para_nb(0:mpi_size-1)) - ALLOCATE(jj_para_begin(0:mpi_size-1)) - ALLOCATE(jj_para_end(0:mpi_size-1)) - - ALLOCATE(ij_para_nb(0:mpi_size-1)) - ALLOCATE(ij_para_begin(0:mpi_size-1)) - ALLOCATE(ij_para_end(0:mpi_size-1)) - - ALLOCATE(ii_para_begin(0:mpi_size-1)) - ALLOCATE(ii_para_end(0:mpi_size-1)) - - ALLOCATE(klon_mpi_para_nb(0:mpi_size-1)) - ALLOCATE(klon_mpi_para_begin(0:mpi_size-1)) - ALLOCATE(klon_mpi_para_end(0:mpi_size-1)) - - - klon_mpi_para_nb(0:mpi_size-1)=distrib(0:mpi_size-1) - - DO i=0,mpi_size-1 - IF (i==0) THEN - klon_mpi_para_begin(i)=1 - ELSE - klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1 - ENDIF - klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1 - ENDDO - - - DO i=0,mpi_size-1 - - IF (i==0) THEN - ij_para_begin(i) = 1 - ELSE - ij_para_begin(i) = klon_mpi_para_begin(i)+nbp_lon-1 - ENDIF - - jj_para_begin(i) = (ij_para_begin(i)-1)/nbp_lon + 1 - ii_para_begin(i) = MOD(ij_para_begin(i)-1,nbp_lon) + 1 - - - ij_para_end(i) = klon_mpi_para_end(i)+nbp_lon-1 - jj_para_end(i) = (ij_para_end(i)-1)/nbp_lon + 1 - ii_para_end(i) = MOD(ij_para_end(i)-1,nbp_lon) + 1 - - - ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1 - jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1 - - ENDDO - - ii_begin = ii_para_begin(mpi_rank) - ii_end = ii_para_end(mpi_rank) - jj_begin = jj_para_begin(mpi_rank) - jj_end = jj_para_end(mpi_rank) - jj_nb = jj_para_nb(mpi_rank) - ij_begin = ij_para_begin(mpi_rank) - ij_end = ij_para_end(mpi_rank) - ij_nb = ij_para_nb(mpi_rank) - klon_mpi_begin = klon_mpi_para_begin(mpi_rank) - klon_mpi_end = klon_mpi_para_end(mpi_rank) - klon_mpi = klon_mpi_para_nb(mpi_rank) - - CALL Print_module_data - -IF (CPPKEY_INCA) THEN - CALL init_inca_para( & - nbp_lon,nbp_lat,nbp_lev,klon_glo,mpi_size, & - distrib,nvertex, grid_type,communicator) -END IF - - END SUBROUTINE Init_phys_lmdz_mpi_data - - SUBROUTINE print_module_data - USE print_control_mod, ONLY: lunout - IMPLICIT NONE -! INCLUDE "iniprint.h" - - WRITE(lunout,*) 'ii_begin =', ii_begin - WRITE(lunout,*) 'ii_end =', ii_end - WRITE(lunout,*) 'jj_begin =',jj_begin - WRITE(lunout,*) 'jj_end =', jj_end - WRITE(lunout,*) 'jj_nb =', jj_nb - WRITE(lunout,*) 'ij_begin =', ij_begin - WRITE(lunout,*) 'ij_end =', ij_end - WRITE(lunout,*) 'ij_nb =', ij_nb - WRITE(lunout,*) 'klon_mpi_begin =', klon_mpi_begin - WRITE(lunout,*) 'klon_mpi_end =', klon_mpi_end - WRITE(lunout,*) 'klon_mpi =', klon_mpi - WRITE(lunout,*) 'jj_para_nb =', jj_para_nb - WRITE(lunout,*) 'jj_para_begin =', jj_para_begin - WRITE(lunout,*) 'jj_para_end =', jj_para_end - WRITE(lunout,*) 'ii_para_begin =', ii_para_begin - WRITE(lunout,*) 'ii_para_end =', ii_para_end - WRITE(lunout,*) 'ij_para_nb =', ij_para_nb - WRITE(lunout,*) 'ij_para_begin =', ij_para_begin - WRITE(lunout,*) 'ij_para_end =', ij_para_end - WRITE(lunout,*) 'klon_mpi_para_nb =', klon_mpi_para_nb - WRITE(lunout,*) 'klon_mpi_para_begin =', klon_mpi_para_begin - WRITE(lunout,*) 'klon_mpi_para_end =', klon_mpi_para_end - WRITE(lunout,*) 'mpi_rank =', mpi_rank - WRITE(lunout,*) 'mpi_size =', mpi_size - WRITE(lunout,*) 'mpi_master =', mpi_master - WRITE(lunout,*) 'is_mpi_root =', is_mpi_root - WRITE(lunout,*) 'is_north_pole =', is_north_pole_dyn - WRITE(lunout,*) 'is_south_pole =', is_south_pole_dyn - WRITE(lunout,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY - - END SUBROUTINE print_module_data - -END MODULE mod_phys_lmdz_mpi_data Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_data.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_data.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_data.f90 (revision 5268) @@ -0,0 +1,222 @@ +! +!$Id$ +! +MODULE mod_phys_lmdz_mpi_data + USE lmdz_mpi + USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA + + INTEGER,SAVE :: ii_begin + INTEGER,SAVE :: ii_end + INTEGER,SAVE :: jj_begin + INTEGER,SAVE :: jj_end + INTEGER,SAVE :: jj_nb + INTEGER,SAVE :: ij_begin + INTEGER,SAVE :: ij_end + INTEGER,SAVE :: ij_nb + INTEGER,SAVE :: klon_mpi_begin + INTEGER,SAVE :: klon_mpi_end + INTEGER,SAVE :: klon_mpi + + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end + + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end + + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end + + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end + + + INTEGER,SAVE :: mpi_rank + INTEGER,SAVE :: mpi_size + INTEGER,SAVE :: mpi_master + LOGICAL,SAVE :: is_mpi_root + LOGICAL,SAVE :: is_using_mpi + + + LOGICAL,SAVE :: is_north_pole_dyn + LOGICAL,SAVE :: is_south_pole_dyn + INTEGER,SAVE :: COMM_LMDZ_PHY + INTEGER,SAVE :: MPI_REAL_LMDZ ! MPI_REAL8 + +CONTAINS + + SUBROUTINE init_phys_lmdz_mpi_data(nbp, nbp_lon, nbp_lat, nbp_lev, grid_type, nvertex, communicator) + USE lmdz_mpi + IMPLICIT NONE + INTEGER,INTENT(IN) :: nbp + INTEGER,INTENT(IN) :: nbp_lon + INTEGER,INTENT(IN) :: nbp_lat + INTEGER,INTENT(IN) :: nbp_lev + INTEGER,INTENT(IN) :: communicator + INTEGER,INTENT(IN) :: grid_type + INTEGER,INTENT(IN) :: nvertex + + INTEGER,ALLOCATABLE :: distrib(:) + INTEGER :: ierr + INTEGER :: klon_glo + INTEGER :: i + + is_using_mpi = using_mpi + + if ((nbp_lon.eq.1).and.(nbp_lat.eq.1)) then ! running 1D column model + klon_glo=1 + else + ! The usual global physics grid: 1 point for each pole and nbp_lon points + ! for all other latitudes + klon_glo=nbp_lon*(nbp_lat-2)+2 + endif + + COMM_LMDZ_PHY=communicator + + IF (is_using_mpi) THEN + MPI_REAL_LMDZ=MPI_REAL8 + CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr) + CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr) + ELSE + mpi_size=1 + mpi_rank=0 + ENDIF + + ALLOCATE(distrib(0:mpi_size-1)) + + IF (is_using_mpi) THEN + CALL MPI_ALLGATHER(nbp,1,MPI_INTEGER,distrib,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr) + ELSE + distrib(:)=nbp + ENDIF + + + IF (mpi_rank == 0) THEN + mpi_master = 0 + is_mpi_root = .true. + ENDIF + + IF (mpi_rank == 0) THEN + is_north_pole_dyn = .TRUE. + ELSE + is_north_pole_dyn = .FALSE. + ENDIF + + IF (mpi_rank == mpi_size-1) THEN + is_south_pole_dyn = .TRUE. + ELSE + is_south_pole_dyn = .FALSE. + ENDIF + + ALLOCATE(jj_para_nb(0:mpi_size-1)) + ALLOCATE(jj_para_begin(0:mpi_size-1)) + ALLOCATE(jj_para_end(0:mpi_size-1)) + + ALLOCATE(ij_para_nb(0:mpi_size-1)) + ALLOCATE(ij_para_begin(0:mpi_size-1)) + ALLOCATE(ij_para_end(0:mpi_size-1)) + + ALLOCATE(ii_para_begin(0:mpi_size-1)) + ALLOCATE(ii_para_end(0:mpi_size-1)) + + ALLOCATE(klon_mpi_para_nb(0:mpi_size-1)) + ALLOCATE(klon_mpi_para_begin(0:mpi_size-1)) + ALLOCATE(klon_mpi_para_end(0:mpi_size-1)) + + + klon_mpi_para_nb(0:mpi_size-1)=distrib(0:mpi_size-1) + + DO i=0,mpi_size-1 + IF (i==0) THEN + klon_mpi_para_begin(i)=1 + ELSE + klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1 + ENDIF + klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1 + ENDDO + + + DO i=0,mpi_size-1 + + IF (i==0) THEN + ij_para_begin(i) = 1 + ELSE + ij_para_begin(i) = klon_mpi_para_begin(i)+nbp_lon-1 + ENDIF + + jj_para_begin(i) = (ij_para_begin(i)-1)/nbp_lon + 1 + ii_para_begin(i) = MOD(ij_para_begin(i)-1,nbp_lon) + 1 + + + ij_para_end(i) = klon_mpi_para_end(i)+nbp_lon-1 + jj_para_end(i) = (ij_para_end(i)-1)/nbp_lon + 1 + ii_para_end(i) = MOD(ij_para_end(i)-1,nbp_lon) + 1 + + + ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1 + jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1 + + ENDDO + + ii_begin = ii_para_begin(mpi_rank) + ii_end = ii_para_end(mpi_rank) + jj_begin = jj_para_begin(mpi_rank) + jj_end = jj_para_end(mpi_rank) + jj_nb = jj_para_nb(mpi_rank) + ij_begin = ij_para_begin(mpi_rank) + ij_end = ij_para_end(mpi_rank) + ij_nb = ij_para_nb(mpi_rank) + klon_mpi_begin = klon_mpi_para_begin(mpi_rank) + klon_mpi_end = klon_mpi_para_end(mpi_rank) + klon_mpi = klon_mpi_para_nb(mpi_rank) + + CALL Print_module_data + +IF (CPPKEY_INCA) THEN + CALL init_inca_para( & + nbp_lon,nbp_lat,nbp_lev,klon_glo,mpi_size, & + distrib,nvertex, grid_type,communicator) +END IF + + END SUBROUTINE Init_phys_lmdz_mpi_data + + SUBROUTINE print_module_data + USE print_control_mod, ONLY: lunout + IMPLICIT NONE +! INCLUDE "iniprint.h" + + WRITE(lunout,*) 'ii_begin =', ii_begin + WRITE(lunout,*) 'ii_end =', ii_end + WRITE(lunout,*) 'jj_begin =',jj_begin + WRITE(lunout,*) 'jj_end =', jj_end + WRITE(lunout,*) 'jj_nb =', jj_nb + WRITE(lunout,*) 'ij_begin =', ij_begin + WRITE(lunout,*) 'ij_end =', ij_end + WRITE(lunout,*) 'ij_nb =', ij_nb + WRITE(lunout,*) 'klon_mpi_begin =', klon_mpi_begin + WRITE(lunout,*) 'klon_mpi_end =', klon_mpi_end + WRITE(lunout,*) 'klon_mpi =', klon_mpi + WRITE(lunout,*) 'jj_para_nb =', jj_para_nb + WRITE(lunout,*) 'jj_para_begin =', jj_para_begin + WRITE(lunout,*) 'jj_para_end =', jj_para_end + WRITE(lunout,*) 'ii_para_begin =', ii_para_begin + WRITE(lunout,*) 'ii_para_end =', ii_para_end + WRITE(lunout,*) 'ij_para_nb =', ij_para_nb + WRITE(lunout,*) 'ij_para_begin =', ij_para_begin + WRITE(lunout,*) 'ij_para_end =', ij_para_end + WRITE(lunout,*) 'klon_mpi_para_nb =', klon_mpi_para_nb + WRITE(lunout,*) 'klon_mpi_para_begin =', klon_mpi_para_begin + WRITE(lunout,*) 'klon_mpi_para_end =', klon_mpi_para_end + WRITE(lunout,*) 'mpi_rank =', mpi_rank + WRITE(lunout,*) 'mpi_size =', mpi_size + WRITE(lunout,*) 'mpi_master =', mpi_master + WRITE(lunout,*) 'is_mpi_root =', is_mpi_root + WRITE(lunout,*) 'is_north_pole =', is_north_pole_dyn + WRITE(lunout,*) 'is_south_pole =', is_south_pole_dyn + WRITE(lunout,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY + + END SUBROUTINE print_module_data + +END MODULE mod_phys_lmdz_mpi_data Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90 (revision 5267) +++ (revision ) @@ -1,2025 +1,0 @@ -! -!$Id$ -! -MODULE mod_phys_lmdz_mpi_transfert - - - INTERFACE bcast_mpi - MODULE PROCEDURE bcast_mpi_c, & - 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 - 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 - 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 scatter2D_mpi - MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, & - 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 - MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, & - 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 - 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 - - INTERFACE reduce_min_mpi - MODULE PROCEDURE reduce_min_mpi_i,reduce_min_mpi_i1,reduce_min_mpi_i2,reduce_min_mpi_i3,reduce_min_mpi_i4, & - reduce_min_mpi_r,reduce_min_mpi_r1,reduce_min_mpi_r2,reduce_min_mpi_r3,reduce_min_mpi_r4 - END INTERFACE - - INTERFACE grid1dTo2d_mpi - MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, & - grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, & - grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3 - END INTERFACE - - INTERFACE grid2dTo1d_mpi - MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, & - grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, & - grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3 - END INTERFACE - -CONTAINS - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Broadcast --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! -- Les chaine de charactère -- !! - - SUBROUTINE bcast_mpi_c(var1) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(INOUT) :: Var1 - - CALL bcast_mpi_cgen(Var1,len(Var1)) - - END SUBROUTINE bcast_mpi_c - -!! -- Les entiers -- !! - - SUBROUTINE bcast_mpi_i(var) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var - - INTEGER :: var_tmp(1) - - IF (is_mpi_root) var_tmp(1)=var - CALL bcast_mpi_igen(Var_tmp,1) - var=var_tmp(1) - - END SUBROUTINE bcast_mpi_i - - SUBROUTINE bcast_mpi_i1(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:) - - CALL bcast_mpi_igen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_i1 - - SUBROUTINE bcast_mpi_i2(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:) - - CALL bcast_mpi_igen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_i2 - - SUBROUTINE bcast_mpi_i3(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:,:) - - CALL bcast_mpi_igen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_i3 - - SUBROUTINE bcast_mpi_i4(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:,:,:) - - CALL bcast_mpi_igen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_i4 - - -!! -- Les reels -- !! - - SUBROUTINE bcast_mpi_r(var) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var - REAL :: var_tmp(1) - - IF (is_mpi_root) var_tmp(1)=var - CALL bcast_mpi_rgen(Var_tmp,1) - var=var_tmp(1) - - END SUBROUTINE bcast_mpi_r - - SUBROUTINE bcast_mpi_r1(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:) - - CALL bcast_mpi_rgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_r1 - - SUBROUTINE bcast_mpi_r2(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:) - - CALL bcast_mpi_rgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_r2 - - SUBROUTINE bcast_mpi_r3(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:,:) - - CALL bcast_mpi_rgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_r3 - - SUBROUTINE bcast_mpi_r4(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:,:,:) - - CALL bcast_mpi_rgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_r4 - -!! -- Les booleans -- !! - - SUBROUTINE bcast_mpi_l(var) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var - LOGICAL :: var_tmp(1) - - IF (is_mpi_root) var_tmp(1)=var - CALL bcast_mpi_lgen(Var_tmp,1) - var=var_tmp(1) - - END SUBROUTINE bcast_mpi_l - - SUBROUTINE bcast_mpi_l1(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:) - - CALL bcast_mpi_lgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_l1 - - SUBROUTINE bcast_mpi_l2(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:) - - CALL bcast_mpi_lgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_l2 - - SUBROUTINE bcast_mpi_l3(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:,:) - - CALL bcast_mpi_lgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_l3 - - SUBROUTINE bcast_mpi_l4(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) - - CALL bcast_mpi_lgen(Var,size(Var)) - - END SUBROUTINE bcast_mpi_l4 - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Scatter --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE scatter_mpi_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL scatter_mpi_igen(VarIn,Varout,1) - - END SUBROUTINE scatter_mpi_i - - SUBROUTINE scatter_mpi_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)) - - END SUBROUTINE scatter_mpi_i1 - - SUBROUTINE scatter_mpi_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)) - - END SUBROUTINE scatter_mpi_i2 - - SUBROUTINE scatter_mpi_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4)) - - END SUBROUTINE scatter_mpi_i3 - - - SUBROUTINE scatter_mpi_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL scatter_mpi_rgen(VarIn,Varout,1) - - END SUBROUTINE scatter_mpi_r - - SUBROUTINE scatter_mpi_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)) - - END SUBROUTINE scatter_mpi_r1 - - SUBROUTINE scatter_mpi_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)) - - END SUBROUTINE scatter_mpi_r2 - - SUBROUTINE scatter_mpi_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4)) - - END SUBROUTINE scatter_mpi_r3 - - - SUBROUTINE scatter_mpi_l(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL scatter_mpi_lgen(VarIn,Varout,1) - - END SUBROUTINE scatter_mpi_l - - SUBROUTINE scatter_mpi_l1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)) - - END SUBROUTINE scatter_mpi_l1 - - SUBROUTINE scatter_mpi_l2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)) - - END SUBROUTINE scatter_mpi_l2 - - SUBROUTINE scatter_mpi_l3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4)) - - END SUBROUTINE scatter_mpi_l3 - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Gather --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!!!!! --> Les entiers - - SUBROUTINE gather_mpi_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL gather_mpi_igen(VarIn,VarOut,1) - - END SUBROUTINE gather_mpi_i - - -!!!!! - - SUBROUTINE gather_mpi_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)) - - END SUBROUTINE gather_mpi_i1 - -!!!!! - - SUBROUTINE gather_mpi_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)) - - END SUBROUTINE gather_mpi_i2 - -!!!!! - - SUBROUTINE gather_mpi_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) - - END SUBROUTINE gather_mpi_i3 - -!!!!! --> Les reels - - SUBROUTINE gather_mpi_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL gather_mpi_rgen(VarIn,VarOut,1) - - END SUBROUTINE gather_mpi_r - -!!!!! - - SUBROUTINE gather_mpi_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)) - - END SUBROUTINE gather_mpi_r1 - -!!!!! - - SUBROUTINE gather_mpi_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)) - - END SUBROUTINE gather_mpi_r2 - -!!!!! - - SUBROUTINE gather_mpi_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) - - END SUBROUTINE gather_mpi_r3 - -!!!!! --> Les booleen - - SUBROUTINE gather_mpi_l(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL gather_mpi_lgen(VarIn,VarOut,1) - - END SUBROUTINE gather_mpi_l - -!!!!! - - SUBROUTINE gather_mpi_l1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)) - - END SUBROUTINE gather_mpi_l1 - -!!!!! - - SUBROUTINE gather_mpi_l2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)) - - END SUBROUTINE gather_mpi_l2 - -!!!!! - - SUBROUTINE gather_mpi_l3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) - - END SUBROUTINE gather_mpi_l3 - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Scatter2D --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE scatter2D_mpi_i(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - INTEGER,DIMENSION(klon_glo) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_i - - SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_i1 - - SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_i2 - - SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_i3 - - - - SUBROUTINE scatter2D_mpi_r(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - REAL,DIMENSION(klon_glo) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_R - - - SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_r1 - - - SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_r2 - - SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_r3 - - - SUBROUTINE scatter2D_mpi_l(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - LOGICAL,DIMENSION(klon_glo) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_l - - - SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_l1 - - - SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_l2 - - SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp - - CALL grid2dTo1d_glo(VarIn,Var_tmp) - CALL scatter_mpi(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_mpi_l3 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Gather2D --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE gather2D_mpi_i(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - INTEGER,DIMENSION(klon_glo) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_i - - SUBROUTINE gather2D_mpi_i1(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_i1 - - SUBROUTINE gather2D_mpi_i2(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_i2 - - SUBROUTINE gather2D_mpi_i3(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_i3 - - - - SUBROUTINE gather2D_mpi_r(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL,DIMENSION(klon_glo) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_r - - SUBROUTINE gather2D_mpi_r1(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_r1 - - SUBROUTINE gather2D_mpi_r2(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_r2 - - SUBROUTINE gather2D_mpi_r3(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_r3 - - - - SUBROUTINE gather2D_mpi_l(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - LOGICAL,DIMENSION(klon_glo) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_l - - SUBROUTINE gather2D_mpi_l1(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_l1 - - SUBROUTINE gather2D_mpi_l2(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_l2 - - SUBROUTINE gather2D_mpi_l3(VarIn, VarOut) - USE mod_grid_phy_lmdz - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp - - CALL gather_mpi(VarIn,Var_tmp) - CALL grid1dTo2d_glo(Var_tmp,VarOut) - - END SUBROUTINE gather2D_mpi_l3 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des reduce_sum --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN) :: VarIn - INTEGER,INTENT(OUT) :: VarOut - INTEGER :: VarIn_tmp(1) - INTEGER :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_sum_mpi_i - - SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_i1 - - SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_i2 - - SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_i3 - - SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_i4 - - - SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN) :: VarIn - REAL,INTENT(OUT) :: VarOut - REAL :: VarIn_tmp(1) - REAL :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_sum_mpi_r - - SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_r1 - - SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_r2 - - SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_r3 - - SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_sum_mpi_r4 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des reduce_min --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE reduce_min_mpi_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN) :: VarIn - INTEGER,INTENT(OUT) :: VarOut - INTEGER :: VarIn_tmp(1) - INTEGER :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL reduce_min_mpi_igen(VarIn_tmp,Varout_tmp,1) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_min_mpi_i - - SUBROUTINE reduce_min_mpi_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_i1 - - SUBROUTINE reduce_min_mpi_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_i2 - - SUBROUTINE reduce_min_mpi_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_i3 - - SUBROUTINE reduce_min_mpi_i4(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_i4 - - - SUBROUTINE reduce_min_mpi_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN) :: VarIn - REAL,INTENT(OUT) :: VarOut - REAL :: VarIn_tmp(1) - REAL :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL reduce_min_mpi_rgen(VarIn_tmp,Varout_tmp,1) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_min_mpi_r - - SUBROUTINE reduce_min_mpi_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_r1 - - SUBROUTINE reduce_min_mpi_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_r2 - - SUBROUTINE reduce_min_mpi_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_r3 - - SUBROUTINE reduce_min_mpi_r4(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) - - END SUBROUTINE reduce_min_mpi_r4 - - - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! SUBROUTINE grid1dTo2d !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1) - - END SUBROUTINE grid1dTo2d_mpi_i - - - SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)) - - END SUBROUTINE grid1dTo2d_mpi_i1 - - SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) - - END SUBROUTINE grid1dTo2d_mpi_i2 - - SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid1dTo2d_mpi_i3 - - - SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1) - - END SUBROUTINE grid1dTo2d_mpi_r - - - SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)) - - END SUBROUTINE grid1dTo2d_mpi_r1 - - SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) - - END SUBROUTINE grid1dTo2d_mpi_r2 - - SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid1dTo2d_mpi_r3 - - - - SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1) - - END SUBROUTINE grid1dTo2d_mpi_l - - - SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)) - - END SUBROUTINE grid1dTo2d_mpi_l1 - - SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) - - END SUBROUTINE grid1dTo2d_mpi_l2 - - SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid1dTo2d_mpi_l3 - - - SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1) - - END SUBROUTINE grid2dTo1d_mpi_i - - - SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)) - - END SUBROUTINE grid2dTo1d_mpi_i1 - - SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid2dTo1d_mpi_i2 - - SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut) - IMPLICIT NONE - INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) - - END SUBROUTINE grid2dTo1d_mpi_i3 - - - - - SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1) - - END SUBROUTINE grid2dTo1d_mpi_r - - - SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)) - - END SUBROUTINE grid2dTo1d_mpi_r1 - - SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid2dTo1d_mpi_r2 - - SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut) - IMPLICIT NONE - REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) - - END SUBROUTINE grid2dTo1d_mpi_r3 - - - - SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1) - - END SUBROUTINE grid2dTo1d_mpi_l - - - SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)) - - END SUBROUTINE grid2dTo1d_mpi_l1 - - - - SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) - - END SUBROUTINE grid2dTo1d_mpi_l2 - - - SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut) - IMPLICIT NONE - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) - - END SUBROUTINE grid2dTo1d_mpi_l3 - - - - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE bcast_mpi_cgen(var,nb) - USE mod_phys_lmdz_mpi_data - USE lmdz_mpi - IMPLICIT NONE - - CHARACTER(LEN=*),INTENT(INOUT) :: Var - INTEGER,INTENT(IN) :: nb - - INTEGER :: ierr - - IF (.not.is_using_mpi) RETURN - - CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE bcast_mpi_cgen - - - - SUBROUTINE bcast_mpi_igen(var,nb) - USE mod_phys_lmdz_mpi_data - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: nb - INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var - - INTEGER :: ierr - - IF (.not.is_using_mpi) RETURN - - CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE bcast_mpi_igen - - - - - SUBROUTINE bcast_mpi_rgen(var,nb) - USE mod_phys_lmdz_mpi_data - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: nb - REAL,DIMENSION(nb),INTENT(INOUT) :: Var - - INTEGER :: ierr - - IF (.not.is_using_mpi) RETURN - - CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE bcast_mpi_rgen - - - - - SUBROUTINE bcast_mpi_lgen(var,nb) - USE mod_phys_lmdz_mpi_data - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: nb - LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var - - INTEGER :: ierr - - IF (.not.is_using_mpi) RETURN - - CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE bcast_mpi_lgen - - - - SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - - INTEGER,DIMENSION(0:mpi_size-1) :: displs - INTEGER,DIMENSION(0:mpi_size-1) :: counts - INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp - INTEGER :: nb,i,index,rank - INTEGER :: ierr - - - IF (.not.is_using_mpi) THEN - VarOut(:,:)=VarIn(:,:) - RETURN - ENDIF - - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - displs(rank)=Index-1 - counts(rank)=nb*dimsize - DO i=1,dimsize - VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i) - Index=Index+nb - ENDDO - ENDDO - ENDIF - - CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize, & - MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr) - - END SUBROUTINE scatter_mpi_igen - - SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - - INTEGER,DIMENSION(0:mpi_size-1) :: displs - INTEGER,DIMENSION(0:mpi_size-1) :: counts - REAL,DIMENSION(dimsize*klon_glo) :: VarTmp - INTEGER :: nb,i,index,rank - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:,:)=VarIn(:,:) - RETURN - ENDIF - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - displs(rank)=Index-1 - counts(rank)=nb*dimsize - DO i=1,dimsize - VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i) - Index=Index+nb - ENDDO - ENDDO - ENDIF - - CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize, & - MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr) - - END SUBROUTINE scatter_mpi_rgen - - - SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - - - INTEGER,DIMENSION(0:mpi_size-1) :: displs - INTEGER,DIMENSION(0:mpi_size-1) :: counts - LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp - INTEGER :: nb,i,index,rank - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:,:)=VarIn(:,:) - RETURN - ENDIF - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - displs(rank)=Index-1 - counts(rank)=nb*dimsize - DO i=1,dimsize - VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i) - Index=Index+nb - ENDDO - ENDDO - ENDIF - - CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize, & - MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr) - - END SUBROUTINE scatter_mpi_lgen - - - - - SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut - - INTEGER,DIMENSION(0:mpi_size-1) :: displs - INTEGER,DIMENSION(0:mpi_size-1) :: counts - INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp - INTEGER :: nb,i,index,rank - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:,:)=VarIn(:,:) - RETURN - ENDIF - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - displs(rank)=Index-1 - counts(rank)=nb*dimsize - Index=Index+nb*dimsize - ENDDO - - ENDIF - - CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs, & - MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr) - - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - DO i=1,dimsize - VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) - Index=Index+nb - ENDDO - ENDDO - ENDIF - - END SUBROUTINE gather_mpi_igen - - SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut - - INTEGER,DIMENSION(0:mpi_size-1) :: displs - INTEGER,DIMENSION(0:mpi_size-1) :: counts - REAL,DIMENSION(dimsize*klon_glo) :: VarTmp - INTEGER :: nb,i,index,rank - INTEGER :: ierr - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - displs(rank)=Index-1 - counts(rank)=nb*dimsize - Index=Index+nb*dimsize - ENDDO - ENDIF - - IF (.not.is_using_mpi) THEN - VarOut(:,:)=VarIn(:,:) - RETURN - ENDIF - - CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs, & - MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr) - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - DO i=1,dimsize - VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) - Index=Index+nb - ENDDO - ENDDO - ENDIF - - END SUBROUTINE gather_mpi_rgen - - SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut - - INTEGER,DIMENSION(0:mpi_size-1) :: displs - INTEGER,DIMENSION(0:mpi_size-1) :: counts - LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp - INTEGER :: nb,i,index,rank - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:,:)=VarIn(:,:) - RETURN - ENDIF - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - displs(rank)=Index-1 - counts(rank)=nb*dimsize - Index=Index+nb*dimsize - ENDDO - ENDIF - - - CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs, & - MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr) - - IF (is_mpi_root) THEN - Index=1 - DO rank=0,mpi_size-1 - nb=klon_mpi_para_nb(rank) - DO i=1,dimsize - VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) - Index=Index+nb - ENDDO - ENDDO - ENDIF - - END SUBROUTINE gather_mpi_lgen - - - - SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: nb - INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn - INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:)=VarIn(:) - RETURN - ENDIF - - - CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE reduce_sum_mpi_igen - - SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: nb - REAL,DIMENSION(nb),INTENT(IN) :: VarIn - REAL,DIMENSION(nb),INTENT(OUT) :: VarOut - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:)=VarIn(:) - RETURN - ENDIF - - CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE reduce_sum_mpi_rgen - - - - SUBROUTINE reduce_min_mpi_igen(VarIn,VarOut,nb) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: nb - INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn - INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:)=VarIn(:) - RETURN - ENDIF - - - CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_MIN,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE reduce_min_mpi_igen - - SUBROUTINE reduce_min_mpi_rgen(VarIn,VarOut,nb) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - USE lmdz_mpi - - IMPLICIT NONE - - INTEGER,INTENT(IN) :: nb - REAL,DIMENSION(nb),INTENT(IN) :: VarIn - REAL,DIMENSION(nb),INTENT(OUT) :: VarOut - INTEGER :: ierr - - IF (.not.is_using_mpi) THEN - VarOut(:)=VarIn(:) - RETURN - ENDIF - - CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_MIN,mpi_master,COMM_LMDZ_PHY,ierr) - - END SUBROUTINE reduce_min_mpi_rgen - - - - - - - - SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize) :: VarOut - INTEGER :: i,ij,Offset - - - VarOut(1:nbp_lon,:)=0 - VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0 - - offset=ii_begin - IF (is_north_pole_dyn) Offset=nbp_lon - - - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij+offset-1,i)=VarIn(ij,i) - ENDDO - ENDDO - - - IF (is_north_pole_dyn) THEN - DO i=1,dimsize - DO ij=1,nbp_lon - VarOut(ij,i)=VarIn(1,i) - ENDDO - ENDDO - ENDIF - - IF (is_south_pole_dyn) THEN - DO i=1,dimsize - DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb - VarOut(ij,i)=VarIn(klon_mpi,i) - ENDDO - ENDDO - ENDIF - - END SUBROUTINE grid1dTo2d_mpi_igen - - - SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize) :: VarOut - INTEGER :: i,ij,Offset - - - VarOut(1:nbp_lon,:)=0 - VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0 - - offset=ii_begin - IF (is_north_pole_dyn) Offset=nbp_lon - - - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij+offset-1,i)=VarIn(ij,i) - ENDDO - ENDDO - - - IF (is_north_pole_dyn) THEN - DO i=1,dimsize - DO ij=1,nbp_lon - VarOut(ij,i)=VarIn(1,i) - ENDDO - ENDDO - ENDIF - - IF (is_south_pole_dyn) THEN - DO i=1,dimsize - DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb - VarOut(ij,i)=VarIn(klon_mpi,i) - ENDDO - ENDDO - ENDIF - - END SUBROUTINE grid1dTo2d_mpi_rgen - - - - SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize) :: VarOut - INTEGER :: i,ij,Offset - - - VarOut(1:nbp_lon,:)=.FALSE. - VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE. - - offset=ii_begin - IF (is_north_pole_dyn) Offset=nbp_lon - - - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij+offset-1,i)=VarIn(ij,i) - ENDDO - ENDDO - - - IF (is_north_pole_dyn) THEN - DO i=1,dimsize - DO ij=1,nbp_lon - VarOut(ij,i)=VarIn(1,i) - ENDDO - ENDDO - ENDIF - - IF (is_south_pole_dyn) THEN - DO i=1,dimsize - DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb - VarOut(ij,i)=VarIn(klon_mpi,i) - ENDDO - ENDDO - ENDIF - - END SUBROUTINE grid1dTo2d_mpi_lgen - - - - - SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - INTEGER :: i,ij,offset - - offset=ii_begin - IF (is_north_pole_dyn) offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij,i)=VarIn(ij+offset-1,i) - ENDDO - ENDDO - - IF (is_north_pole_dyn) THEN - DO i=1,dimsize - VarOut(1,i)=VarIn(1,i) - ENDDO - ENDIF - - - END SUBROUTINE grid2dTo1d_mpi_igen - - - - SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - INTEGER :: i,ij,offset - - offset=ii_begin - IF (is_north_pole_dyn) offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij,i)=VarIn(ij+offset-1,i) - ENDDO - ENDDO - - IF (is_north_pole_dyn) THEN - DO i=1,dimsize - VarOut(1,i)=VarIn(1,i) - ENDDO - ENDIF - - - END SUBROUTINE grid2dTo1d_mpi_rgen - - - SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize) - USE mod_phys_lmdz_mpi_data - USE mod_grid_phy_lmdz - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - INTEGER :: i,ij,offset - - offset=ii_begin - IF (is_north_pole_dyn) offset=nbp_lon - - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij,i)=VarIn(ij+offset-1,i) - ENDDO - ENDDO - - IF (is_north_pole_dyn) THEN - DO i=1,dimsize - VarOut(1,i)=VarIn(1,i) - ENDDO - ENDIF - - - END SUBROUTINE grid2dTo1d_mpi_lgen - -END MODULE mod_phys_lmdz_mpi_transfert - Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90 (revision 5268) @@ -0,0 +1,2025 @@ +! +!$Id$ +! +MODULE mod_phys_lmdz_mpi_transfert + + + INTERFACE bcast_mpi + MODULE PROCEDURE bcast_mpi_c, & + 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 + 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 + 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 scatter2D_mpi + MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, & + 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 + MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, & + 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 + 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 + + INTERFACE reduce_min_mpi + MODULE PROCEDURE reduce_min_mpi_i,reduce_min_mpi_i1,reduce_min_mpi_i2,reduce_min_mpi_i3,reduce_min_mpi_i4, & + reduce_min_mpi_r,reduce_min_mpi_r1,reduce_min_mpi_r2,reduce_min_mpi_r3,reduce_min_mpi_r4 + END INTERFACE + + INTERFACE grid1dTo2d_mpi + MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, & + grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, & + grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3 + END INTERFACE + + INTERFACE grid2dTo1d_mpi + MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, & + grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, & + grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3 + END INTERFACE + +CONTAINS + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Broadcast --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! -- Les chaine de charactère -- !! + + SUBROUTINE bcast_mpi_c(var1) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(INOUT) :: Var1 + + CALL bcast_mpi_cgen(Var1,len(Var1)) + + END SUBROUTINE bcast_mpi_c + +!! -- Les entiers -- !! + + SUBROUTINE bcast_mpi_i(var) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var + + INTEGER :: var_tmp(1) + + IF (is_mpi_root) var_tmp(1)=var + CALL bcast_mpi_igen(Var_tmp,1) + var=var_tmp(1) + + END SUBROUTINE bcast_mpi_i + + SUBROUTINE bcast_mpi_i1(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:) + + CALL bcast_mpi_igen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_i1 + + SUBROUTINE bcast_mpi_i2(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:) + + CALL bcast_mpi_igen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_i2 + + SUBROUTINE bcast_mpi_i3(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:,:) + + CALL bcast_mpi_igen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_i3 + + SUBROUTINE bcast_mpi_i4(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:,:,:) + + CALL bcast_mpi_igen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_i4 + + +!! -- Les reels -- !! + + SUBROUTINE bcast_mpi_r(var) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var + REAL :: var_tmp(1) + + IF (is_mpi_root) var_tmp(1)=var + CALL bcast_mpi_rgen(Var_tmp,1) + var=var_tmp(1) + + END SUBROUTINE bcast_mpi_r + + SUBROUTINE bcast_mpi_r1(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:) + + CALL bcast_mpi_rgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_r1 + + SUBROUTINE bcast_mpi_r2(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:) + + CALL bcast_mpi_rgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_r2 + + SUBROUTINE bcast_mpi_r3(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:,:) + + CALL bcast_mpi_rgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_r3 + + SUBROUTINE bcast_mpi_r4(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:,:,:) + + CALL bcast_mpi_rgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_r4 + +!! -- Les booleans -- !! + + SUBROUTINE bcast_mpi_l(var) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var + LOGICAL :: var_tmp(1) + + IF (is_mpi_root) var_tmp(1)=var + CALL bcast_mpi_lgen(Var_tmp,1) + var=var_tmp(1) + + END SUBROUTINE bcast_mpi_l + + SUBROUTINE bcast_mpi_l1(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:) + + CALL bcast_mpi_lgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_l1 + + SUBROUTINE bcast_mpi_l2(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:) + + CALL bcast_mpi_lgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_l2 + + SUBROUTINE bcast_mpi_l3(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:,:) + + CALL bcast_mpi_lgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_l3 + + SUBROUTINE bcast_mpi_l4(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) + + CALL bcast_mpi_lgen(Var,size(Var)) + + END SUBROUTINE bcast_mpi_l4 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Scatter --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE scatter_mpi_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL scatter_mpi_igen(VarIn,Varout,1) + + END SUBROUTINE scatter_mpi_i + + SUBROUTINE scatter_mpi_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)) + + END SUBROUTINE scatter_mpi_i1 + + SUBROUTINE scatter_mpi_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)) + + END SUBROUTINE scatter_mpi_i2 + + SUBROUTINE scatter_mpi_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4)) + + END SUBROUTINE scatter_mpi_i3 + + + SUBROUTINE scatter_mpi_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL scatter_mpi_rgen(VarIn,Varout,1) + + END SUBROUTINE scatter_mpi_r + + SUBROUTINE scatter_mpi_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)) + + END SUBROUTINE scatter_mpi_r1 + + SUBROUTINE scatter_mpi_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)) + + END SUBROUTINE scatter_mpi_r2 + + SUBROUTINE scatter_mpi_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4)) + + END SUBROUTINE scatter_mpi_r3 + + + SUBROUTINE scatter_mpi_l(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL scatter_mpi_lgen(VarIn,Varout,1) + + END SUBROUTINE scatter_mpi_l + + SUBROUTINE scatter_mpi_l1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)) + + END SUBROUTINE scatter_mpi_l1 + + SUBROUTINE scatter_mpi_l2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)) + + END SUBROUTINE scatter_mpi_l2 + + SUBROUTINE scatter_mpi_l3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4)) + + END SUBROUTINE scatter_mpi_l3 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Gather --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!! --> Les entiers + + SUBROUTINE gather_mpi_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL gather_mpi_igen(VarIn,VarOut,1) + + END SUBROUTINE gather_mpi_i + + +!!!!! + + SUBROUTINE gather_mpi_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)) + + END SUBROUTINE gather_mpi_i1 + +!!!!! + + SUBROUTINE gather_mpi_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)) + + END SUBROUTINE gather_mpi_i2 + +!!!!! + + SUBROUTINE gather_mpi_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) + + END SUBROUTINE gather_mpi_i3 + +!!!!! --> Les reels + + SUBROUTINE gather_mpi_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL gather_mpi_rgen(VarIn,VarOut,1) + + END SUBROUTINE gather_mpi_r + +!!!!! + + SUBROUTINE gather_mpi_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)) + + END SUBROUTINE gather_mpi_r1 + +!!!!! + + SUBROUTINE gather_mpi_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)) + + END SUBROUTINE gather_mpi_r2 + +!!!!! + + SUBROUTINE gather_mpi_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) + + END SUBROUTINE gather_mpi_r3 + +!!!!! --> Les booleen + + SUBROUTINE gather_mpi_l(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL gather_mpi_lgen(VarIn,VarOut,1) + + END SUBROUTINE gather_mpi_l + +!!!!! + + SUBROUTINE gather_mpi_l1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)) + + END SUBROUTINE gather_mpi_l1 + +!!!!! + + SUBROUTINE gather_mpi_l2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)) + + END SUBROUTINE gather_mpi_l2 + +!!!!! + + SUBROUTINE gather_mpi_l3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) + + END SUBROUTINE gather_mpi_l3 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Scatter2D --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE scatter2D_mpi_i(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + INTEGER,DIMENSION(klon_glo) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_i + + SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_i1 + + SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_i2 + + SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_i3 + + + + SUBROUTINE scatter2D_mpi_r(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + REAL,DIMENSION(klon_glo) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_R + + + SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_r1 + + + SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_r2 + + SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_r3 + + + SUBROUTINE scatter2D_mpi_l(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + LOGICAL,DIMENSION(klon_glo) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_l + + + SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_l1 + + + SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_l2 + + SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp + + CALL grid2dTo1d_glo(VarIn,Var_tmp) + CALL scatter_mpi(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_mpi_l3 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Gather2D --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE gather2D_mpi_i(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + INTEGER,DIMENSION(klon_glo) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_i + + SUBROUTINE gather2D_mpi_i1(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_i1 + + SUBROUTINE gather2D_mpi_i2(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_i2 + + SUBROUTINE gather2D_mpi_i3(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_i3 + + + + SUBROUTINE gather2D_mpi_r(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL,DIMENSION(klon_glo) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_r + + SUBROUTINE gather2D_mpi_r1(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_r1 + + SUBROUTINE gather2D_mpi_r2(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_r2 + + SUBROUTINE gather2D_mpi_r3(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_r3 + + + + SUBROUTINE gather2D_mpi_l(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + LOGICAL,DIMENSION(klon_glo) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_l + + SUBROUTINE gather2D_mpi_l1(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_l1 + + SUBROUTINE gather2D_mpi_l2(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_l2 + + SUBROUTINE gather2D_mpi_l3(VarIn, VarOut) + USE mod_grid_phy_lmdz + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp + + CALL gather_mpi(VarIn,Var_tmp) + CALL grid1dTo2d_glo(Var_tmp,VarOut) + + END SUBROUTINE gather2D_mpi_l3 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des reduce_sum --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN) :: VarIn + INTEGER,INTENT(OUT) :: VarOut + INTEGER :: VarIn_tmp(1) + INTEGER :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_sum_mpi_i + + SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_i1 + + SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_i2 + + SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_i3 + + SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_i4 + + + SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN) :: VarIn + REAL,INTENT(OUT) :: VarOut + REAL :: VarIn_tmp(1) + REAL :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_sum_mpi_r + + SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_r1 + + SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_r2 + + SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_r3 + + SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_sum_mpi_r4 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des reduce_min --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE reduce_min_mpi_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN) :: VarIn + INTEGER,INTENT(OUT) :: VarOut + INTEGER :: VarIn_tmp(1) + INTEGER :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL reduce_min_mpi_igen(VarIn_tmp,Varout_tmp,1) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_min_mpi_i + + SUBROUTINE reduce_min_mpi_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_i1 + + SUBROUTINE reduce_min_mpi_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_i2 + + SUBROUTINE reduce_min_mpi_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_i3 + + SUBROUTINE reduce_min_mpi_i4(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL reduce_min_mpi_igen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_i4 + + + SUBROUTINE reduce_min_mpi_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN) :: VarIn + REAL,INTENT(OUT) :: VarOut + REAL :: VarIn_tmp(1) + REAL :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL reduce_min_mpi_rgen(VarIn_tmp,Varout_tmp,1) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_min_mpi_r + + SUBROUTINE reduce_min_mpi_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_r1 + + SUBROUTINE reduce_min_mpi_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_r2 + + SUBROUTINE reduce_min_mpi_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_r3 + + SUBROUTINE reduce_min_mpi_r4(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL reduce_min_mpi_rgen(VarIn,Varout,SIZE(VarIn)) + + END SUBROUTINE reduce_min_mpi_r4 + + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! SUBROUTINE grid1dTo2d !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1) + + END SUBROUTINE grid1dTo2d_mpi_i + + + SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)) + + END SUBROUTINE grid1dTo2d_mpi_i1 + + SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) + + END SUBROUTINE grid1dTo2d_mpi_i2 + + SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid1dTo2d_mpi_i3 + + + SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1) + + END SUBROUTINE grid1dTo2d_mpi_r + + + SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)) + + END SUBROUTINE grid1dTo2d_mpi_r1 + + SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) + + END SUBROUTINE grid1dTo2d_mpi_r2 + + SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid1dTo2d_mpi_r3 + + + + SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1) + + END SUBROUTINE grid1dTo2d_mpi_l + + + SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)) + + END SUBROUTINE grid1dTo2d_mpi_l1 + + SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)) + + END SUBROUTINE grid1dTo2d_mpi_l2 + + SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid1dTo2d_mpi_l3 + + + SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1) + + END SUBROUTINE grid2dTo1d_mpi_i + + + SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)) + + END SUBROUTINE grid2dTo1d_mpi_i1 + + SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid2dTo1d_mpi_i2 + + SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut) + IMPLICIT NONE + INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) + + END SUBROUTINE grid2dTo1d_mpi_i3 + + + + + SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1) + + END SUBROUTINE grid2dTo1d_mpi_r + + + SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)) + + END SUBROUTINE grid2dTo1d_mpi_r1 + + SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid2dTo1d_mpi_r2 + + SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut) + IMPLICIT NONE + REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) + + END SUBROUTINE grid2dTo1d_mpi_r3 + + + + SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1) + + END SUBROUTINE grid2dTo1d_mpi_l + + + SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)) + + END SUBROUTINE grid2dTo1d_mpi_l1 + + + + SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)) + + END SUBROUTINE grid2dTo1d_mpi_l2 + + + SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut) + IMPLICIT NONE + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5)) + + END SUBROUTINE grid2dTo1d_mpi_l3 + + + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE bcast_mpi_cgen(var,nb) + USE mod_phys_lmdz_mpi_data + USE lmdz_mpi + IMPLICIT NONE + + CHARACTER(LEN=*),INTENT(INOUT) :: Var + INTEGER,INTENT(IN) :: nb + + INTEGER :: ierr + + IF (.not.is_using_mpi) RETURN + + CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE bcast_mpi_cgen + + + + SUBROUTINE bcast_mpi_igen(var,nb) + USE mod_phys_lmdz_mpi_data + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: nb + INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var + + INTEGER :: ierr + + IF (.not.is_using_mpi) RETURN + + CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE bcast_mpi_igen + + + + + SUBROUTINE bcast_mpi_rgen(var,nb) + USE mod_phys_lmdz_mpi_data + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: nb + REAL,DIMENSION(nb),INTENT(INOUT) :: Var + + INTEGER :: ierr + + IF (.not.is_using_mpi) RETURN + + CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE bcast_mpi_rgen + + + + + SUBROUTINE bcast_mpi_lgen(var,nb) + USE mod_phys_lmdz_mpi_data + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: nb + LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var + + INTEGER :: ierr + + IF (.not.is_using_mpi) RETURN + + CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE bcast_mpi_lgen + + + + SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + + INTEGER,DIMENSION(0:mpi_size-1) :: displs + INTEGER,DIMENSION(0:mpi_size-1) :: counts + INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp + INTEGER :: nb,i,index,rank + INTEGER :: ierr + + + IF (.not.is_using_mpi) THEN + VarOut(:,:)=VarIn(:,:) + RETURN + ENDIF + + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + displs(rank)=Index-1 + counts(rank)=nb*dimsize + DO i=1,dimsize + VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i) + Index=Index+nb + ENDDO + ENDDO + ENDIF + + CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize, & + MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr) + + END SUBROUTINE scatter_mpi_igen + + SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + + INTEGER,DIMENSION(0:mpi_size-1) :: displs + INTEGER,DIMENSION(0:mpi_size-1) :: counts + REAL,DIMENSION(dimsize*klon_glo) :: VarTmp + INTEGER :: nb,i,index,rank + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:,:)=VarIn(:,:) + RETURN + ENDIF + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + displs(rank)=Index-1 + counts(rank)=nb*dimsize + DO i=1,dimsize + VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i) + Index=Index+nb + ENDDO + ENDDO + ENDIF + + CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize, & + MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr) + + END SUBROUTINE scatter_mpi_rgen + + + SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + + + INTEGER,DIMENSION(0:mpi_size-1) :: displs + INTEGER,DIMENSION(0:mpi_size-1) :: counts + LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp + INTEGER :: nb,i,index,rank + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:,:)=VarIn(:,:) + RETURN + ENDIF + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + displs(rank)=Index-1 + counts(rank)=nb*dimsize + DO i=1,dimsize + VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i) + Index=Index+nb + ENDDO + ENDDO + ENDIF + + CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize, & + MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr) + + END SUBROUTINE scatter_mpi_lgen + + + + + SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut + + INTEGER,DIMENSION(0:mpi_size-1) :: displs + INTEGER,DIMENSION(0:mpi_size-1) :: counts + INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp + INTEGER :: nb,i,index,rank + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:,:)=VarIn(:,:) + RETURN + ENDIF + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + displs(rank)=Index-1 + counts(rank)=nb*dimsize + Index=Index+nb*dimsize + ENDDO + + ENDIF + + CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs, & + MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr) + + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + DO i=1,dimsize + VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) + Index=Index+nb + ENDDO + ENDDO + ENDIF + + END SUBROUTINE gather_mpi_igen + + SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut + + INTEGER,DIMENSION(0:mpi_size-1) :: displs + INTEGER,DIMENSION(0:mpi_size-1) :: counts + REAL,DIMENSION(dimsize*klon_glo) :: VarTmp + INTEGER :: nb,i,index,rank + INTEGER :: ierr + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + displs(rank)=Index-1 + counts(rank)=nb*dimsize + Index=Index+nb*dimsize + ENDDO + ENDIF + + IF (.not.is_using_mpi) THEN + VarOut(:,:)=VarIn(:,:) + RETURN + ENDIF + + CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs, & + MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr) + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + DO i=1,dimsize + VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) + Index=Index+nb + ENDDO + ENDDO + ENDIF + + END SUBROUTINE gather_mpi_rgen + + SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut + + INTEGER,DIMENSION(0:mpi_size-1) :: displs + INTEGER,DIMENSION(0:mpi_size-1) :: counts + LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp + INTEGER :: nb,i,index,rank + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:,:)=VarIn(:,:) + RETURN + ENDIF + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + displs(rank)=Index-1 + counts(rank)=nb*dimsize + Index=Index+nb*dimsize + ENDDO + ENDIF + + + CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs, & + MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr) + + IF (is_mpi_root) THEN + Index=1 + DO rank=0,mpi_size-1 + nb=klon_mpi_para_nb(rank) + DO i=1,dimsize + VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1) + Index=Index+nb + ENDDO + ENDDO + ENDIF + + END SUBROUTINE gather_mpi_lgen + + + + SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: nb + INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn + INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:)=VarIn(:) + RETURN + ENDIF + + + CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE reduce_sum_mpi_igen + + SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: nb + REAL,DIMENSION(nb),INTENT(IN) :: VarIn + REAL,DIMENSION(nb),INTENT(OUT) :: VarOut + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:)=VarIn(:) + RETURN + ENDIF + + CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE reduce_sum_mpi_rgen + + + + SUBROUTINE reduce_min_mpi_igen(VarIn,VarOut,nb) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: nb + INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn + INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:)=VarIn(:) + RETURN + ENDIF + + + CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_MIN,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE reduce_min_mpi_igen + + SUBROUTINE reduce_min_mpi_rgen(VarIn,VarOut,nb) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + USE lmdz_mpi + + IMPLICIT NONE + + INTEGER,INTENT(IN) :: nb + REAL,DIMENSION(nb),INTENT(IN) :: VarIn + REAL,DIMENSION(nb),INTENT(OUT) :: VarOut + INTEGER :: ierr + + IF (.not.is_using_mpi) THEN + VarOut(:)=VarIn(:) + RETURN + ENDIF + + CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_MIN,mpi_master,COMM_LMDZ_PHY,ierr) + + END SUBROUTINE reduce_min_mpi_rgen + + + + + + + + SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize) :: VarOut + INTEGER :: i,ij,Offset + + + VarOut(1:nbp_lon,:)=0 + VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0 + + offset=ii_begin + IF (is_north_pole_dyn) Offset=nbp_lon + + + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij+offset-1,i)=VarIn(ij,i) + ENDDO + ENDDO + + + IF (is_north_pole_dyn) THEN + DO i=1,dimsize + DO ij=1,nbp_lon + VarOut(ij,i)=VarIn(1,i) + ENDDO + ENDDO + ENDIF + + IF (is_south_pole_dyn) THEN + DO i=1,dimsize + DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb + VarOut(ij,i)=VarIn(klon_mpi,i) + ENDDO + ENDDO + ENDIF + + END SUBROUTINE grid1dTo2d_mpi_igen + + + SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize) :: VarOut + INTEGER :: i,ij,Offset + + + VarOut(1:nbp_lon,:)=0 + VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0 + + offset=ii_begin + IF (is_north_pole_dyn) Offset=nbp_lon + + + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij+offset-1,i)=VarIn(ij,i) + ENDDO + ENDDO + + + IF (is_north_pole_dyn) THEN + DO i=1,dimsize + DO ij=1,nbp_lon + VarOut(ij,i)=VarIn(1,i) + ENDDO + ENDDO + ENDIF + + IF (is_south_pole_dyn) THEN + DO i=1,dimsize + DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb + VarOut(ij,i)=VarIn(klon_mpi,i) + ENDDO + ENDDO + ENDIF + + END SUBROUTINE grid1dTo2d_mpi_rgen + + + + SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize) :: VarOut + INTEGER :: i,ij,Offset + + + VarOut(1:nbp_lon,:)=.FALSE. + VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE. + + offset=ii_begin + IF (is_north_pole_dyn) Offset=nbp_lon + + + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij+offset-1,i)=VarIn(ij,i) + ENDDO + ENDDO + + + IF (is_north_pole_dyn) THEN + DO i=1,dimsize + DO ij=1,nbp_lon + VarOut(ij,i)=VarIn(1,i) + ENDDO + ENDDO + ENDIF + + IF (is_south_pole_dyn) THEN + DO i=1,dimsize + DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb + VarOut(ij,i)=VarIn(klon_mpi,i) + ENDDO + ENDDO + ENDIF + + END SUBROUTINE grid1dTo2d_mpi_lgen + + + + + SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + INTEGER :: i,ij,offset + + offset=ii_begin + IF (is_north_pole_dyn) offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij,i)=VarIn(ij+offset-1,i) + ENDDO + ENDDO + + IF (is_north_pole_dyn) THEN + DO i=1,dimsize + VarOut(1,i)=VarIn(1,i) + ENDDO + ENDIF + + + END SUBROUTINE grid2dTo1d_mpi_igen + + + + SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + INTEGER :: i,ij,offset + + offset=ii_begin + IF (is_north_pole_dyn) offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij,i)=VarIn(ij+offset-1,i) + ENDDO + ENDDO + + IF (is_north_pole_dyn) THEN + DO i=1,dimsize + VarOut(1,i)=VarIn(1,i) + ENDDO + ENDIF + + + END SUBROUTINE grid2dTo1d_mpi_rgen + + + SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize) + USE mod_phys_lmdz_mpi_data + USE mod_grid_phy_lmdz + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + INTEGER :: i,ij,offset + + offset=ii_begin + IF (is_north_pole_dyn) offset=nbp_lon + + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij,i)=VarIn(ij+offset-1,i) + ENDDO + ENDDO + + IF (is_north_pole_dyn) THEN + DO i=1,dimsize + VarOut(1,i)=VarIn(1,i) + ENDDO + ENDIF + + + END SUBROUTINE grid2dTo1d_mpi_lgen + +END MODULE mod_phys_lmdz_mpi_transfert + Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.F90 (revision 5267) +++ (revision ) @@ -1,1256 +1,0 @@ -! -!$Header$ -! -MODULE mod_phys_lmdz_omp_transfert - - PRIVATE - - REAL,PARAMETER :: grow_factor=1.5 - INTEGER,PARAMETER :: size_min=1024 - - CHARACTER(LEN=size_min),SAVE :: buffer_c -! INTEGER,SAVE :: size_c=0 - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_i - INTEGER,SAVE :: size_i=0 - REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_r - INTEGER,SAVE :: size_r=0 - LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_l - INTEGER,SAVE :: size_l=0 - - - - - INTERFACE bcast_omp - MODULE PROCEDURE bcast_omp_c, & - bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, & - bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, & - bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4 - END INTERFACE - - INTERFACE scatter_omp - MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, & - scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, & - scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3 - END INTERFACE - - - INTERFACE gather_omp - MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, & - gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, & - gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3 - END INTERFACE - - - INTERFACE reduce_sum_omp - MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, & - reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4 - END INTERFACE - - INTERFACE reduce_min_omp - MODULE PROCEDURE reduce_min_omp_i,reduce_min_omp_i1,reduce_min_omp_i2,reduce_min_omp_i3,reduce_min_omp_i4, & - reduce_min_omp_r,reduce_min_omp_r1,reduce_min_omp_r2,reduce_min_omp_r3,reduce_min_omp_r4 - END INTERFACE - - - PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, reduce_min_omp, omp_barrier - -CONTAINS - - SUBROUTINE omp_barrier - IMPLICIT NONE - -!$OMP BARRIER - - END SUBROUTINE omp_barrier - - SUBROUTINE check_buffer_i(buff_size) - IMPLICIT NONE - INTEGER :: buff_size - -!$OMP BARRIER -!$OMP MASTER - IF (buff_size>size_i) THEN - IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i) - size_i=MAX(size_min,INT(grow_factor*buff_size)) - ALLOCATE(buffer_i(size_i)) - ENDIF -!$OMP END MASTER -!$OMP BARRIER - - END SUBROUTINE check_buffer_i - - SUBROUTINE check_buffer_r(buff_size) - IMPLICIT NONE - INTEGER :: buff_size - -!$OMP BARRIER -!$OMP MASTER - IF (buff_size>size_r) THEN - IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r) - size_r=MAX(size_min,INT(grow_factor*buff_size)) - ALLOCATE(buffer_r(size_r)) - ENDIF -!$OMP END MASTER -!$OMP BARRIER - - END SUBROUTINE check_buffer_r - - SUBROUTINE check_buffer_l(buff_size) - IMPLICIT NONE - INTEGER :: buff_size - -!$OMP BARRIER -!$OMP MASTER - IF (buff_size>size_l) THEN - IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l) - size_l=MAX(size_min,INT(grow_factor*buff_size)) - ALLOCATE(buffer_l(size_l)) - ENDIF -!$OMP END MASTER -!$OMP BARRIER - - END SUBROUTINE check_buffer_l - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Broadcast --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! -- Les chaine de charactère -- !! - - SUBROUTINE bcast_omp_c(var) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(INOUT) :: Var - - CALL bcast_omp_cgen(Var,len(Var),buffer_c) - - END SUBROUTINE bcast_omp_c - -!! -- Les entiers -- !! - - SUBROUTINE bcast_omp_i(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var - INTEGER :: Var_tmp(1) - - Var_tmp(1)=Var - CALL check_buffer_i(1) - CALL bcast_omp_igen(Var_tmp,1,buffer_i) - Var=Var_tmp(1) - - END SUBROUTINE bcast_omp_i - - - SUBROUTINE bcast_omp_i1(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:) - - CALL check_buffer_i(size(Var)) - CALL bcast_omp_igen(Var,size(Var),buffer_i) - - END SUBROUTINE bcast_omp_i1 - - - SUBROUTINE bcast_omp_i2(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:) - - CALL check_buffer_i(size(Var)) - CALL bcast_omp_igen(Var,size(Var),buffer_i) - - END SUBROUTINE bcast_omp_i2 - - - SUBROUTINE bcast_omp_i3(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:,:) - - CALL check_buffer_i(size(Var)) - CALL bcast_omp_igen(Var,size(Var),buffer_i) - - END SUBROUTINE bcast_omp_i3 - - - SUBROUTINE bcast_omp_i4(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:,:,:) - - CALL check_buffer_i(size(Var)) - CALL bcast_omp_igen(Var,size(Var),buffer_i) - - END SUBROUTINE bcast_omp_i4 - - -!! -- Les reels -- !! - - SUBROUTINE bcast_omp_r(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var - REAL :: Var_tmp(1) - - Var_tmp(1)=Var - CALL check_buffer_r(1) - CALL bcast_omp_rgen(Var_tmp,1,buffer_r) - Var=Var_tmp(1) - - END SUBROUTINE bcast_omp_r - - - SUBROUTINE bcast_omp_r1(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:) - - CALL check_buffer_r(size(Var)) - CALL bcast_omp_rgen(Var,size(Var),buffer_r) - - END SUBROUTINE bcast_omp_r1 - - - SUBROUTINE bcast_omp_r2(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:) - - CALL check_buffer_r(size(Var)) - CALL bcast_omp_rgen(Var,size(Var),buffer_r) - - END SUBROUTINE bcast_omp_r2 - - - SUBROUTINE bcast_omp_r3(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:,:) - - CALL check_buffer_r(size(Var)) - CALL bcast_omp_rgen(Var,size(Var),buffer_r) - - END SUBROUTINE bcast_omp_r3 - - - SUBROUTINE bcast_omp_r4(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:,:,:) - - CALL check_buffer_r(size(Var)) - CALL bcast_omp_rgen(Var,size(Var),buffer_r) - - END SUBROUTINE bcast_omp_r4 - - -!! -- Les booleans -- !! - - SUBROUTINE bcast_omp_l(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var - LOGICAL :: Var_tmp(1) - - Var_tmp(1)=Var - CALL check_buffer_l(1) - CALL bcast_omp_lgen(Var_tmp,1,buffer_l) - Var=Var_tmp(1) - - END SUBROUTINE bcast_omp_l - - - SUBROUTINE bcast_omp_l1(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:) - - CALL check_buffer_l(size(Var)) - CALL bcast_omp_lgen(Var,size(Var),buffer_l) - - END SUBROUTINE bcast_omp_l1 - - - SUBROUTINE bcast_omp_l2(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:) - - CALL check_buffer_l(size(Var)) - CALL bcast_omp_lgen(Var,size(Var),buffer_l) - - END SUBROUTINE bcast_omp_l2 - - - SUBROUTINE bcast_omp_l3(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:,:) - - CALL check_buffer_l(size(Var)) - CALL bcast_omp_lgen(Var,size(Var),buffer_l) - - END SUBROUTINE bcast_omp_l3 - - - SUBROUTINE bcast_omp_l4(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) - - CALL check_buffer_l(size(Var)) - CALL bcast_omp_lgen(Var,size(Var),buffer_l) - - END SUBROUTINE bcast_omp_l4 - - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Scatter --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE scatter_omp_i(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL scatter_omp_igen(VarIn,Varout,1,buffer_i) - - END SUBROUTINE scatter_omp_i - - - SUBROUTINE scatter_omp_i1(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i) - - END SUBROUTINE scatter_omp_i1 - - - SUBROUTINE scatter_omp_i2(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i) - - END SUBROUTINE scatter_omp_i2 - - - SUBROUTINE scatter_omp_i3(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i) - - END SUBROUTINE scatter_omp_i3 - - - - - SUBROUTINE scatter_omp_r(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r) - - END SUBROUTINE scatter_omp_r - - - SUBROUTINE scatter_omp_r1(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r) - - END SUBROUTINE scatter_omp_r1 - - - SUBROUTINE scatter_omp_r2(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r) - - END SUBROUTINE scatter_omp_r2 - - - SUBROUTINE scatter_omp_r3(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r) - - END SUBROUTINE scatter_omp_r3 - - - - SUBROUTINE scatter_omp_l(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_l(size(VarIn)) - CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l) - - END SUBROUTINE scatter_omp_l - - - SUBROUTINE scatter_omp_l1(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_l(size(VarIn)) - CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l) - - END SUBROUTINE scatter_omp_l1 - - - SUBROUTINE scatter_omp_l2(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_l(size(VarIn)) - CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l) - - END SUBROUTINE scatter_omp_l2 - - - SUBROUTINE scatter_omp_l3(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_l(size(VarIn)) - CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l) - - END SUBROUTINE scatter_omp_l3 - - - SUBROUTINE gather_omp_i(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_i(size(VarOut)) - CALL gather_omp_igen(VarIn,Varout,1,buffer_i) - - END SUBROUTINE gather_omp_i - - - SUBROUTINE gather_omp_i1(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_i(size(VarOut)) - CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i) - - END SUBROUTINE gather_omp_i1 - - - SUBROUTINE gather_omp_i2(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarOut)) - CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i) - - END SUBROUTINE gather_omp_i2 - - - SUBROUTINE gather_omp_i3(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarOut)) - CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i) - - END SUBROUTINE gather_omp_i3 - - - - SUBROUTINE gather_omp_r(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL gather_omp_rgen(VarIn,Varout,1) - - END SUBROUTINE gather_omp_r - - - SUBROUTINE gather_omp_r1(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)) - - END SUBROUTINE gather_omp_r1 - - - SUBROUTINE gather_omp_r2(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)) - - END SUBROUTINE gather_omp_r2 - - - SUBROUTINE gather_omp_r3(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) - - END SUBROUTINE gather_omp_r3 - - - SUBROUTINE gather_omp_l(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_l(size(VarOut)) - CALL gather_omp_lgen(VarIn,Varout,1,buffer_l) - - END SUBROUTINE gather_omp_l - - - SUBROUTINE gather_omp_l1(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_l(size(VarOut)) - CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l) - - END SUBROUTINE gather_omp_l1 - - - SUBROUTINE gather_omp_l2(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_l(size(VarOut)) - CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l) - - END SUBROUTINE gather_omp_l2 - - - SUBROUTINE gather_omp_l3(VarIn, VarOut) - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_l(size(VarOut)) - CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l) - - END SUBROUTINE gather_omp_l3 - - - - - SUBROUTINE reduce_sum_omp_i(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: VarIn - INTEGER,INTENT(OUT) :: VarOut - INTEGER :: VarIn_tmp(1) - INTEGER :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL Check_buffer_i(1) - CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_sum_omp_i - - SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_sum_omp_i1 - - - SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_sum_omp_i2 - - - SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_sum_omp_i3 - - - SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_sum_omp_i4 - - - SUBROUTINE reduce_sum_omp_r(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN) :: VarIn - REAL,INTENT(OUT) :: VarOut - REAL :: VarIn_tmp(1) - REAL :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL Check_buffer_r(1) - CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_sum_omp_r - - SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_sum_omp_r1 - - - SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_sum_omp_r2 - - - SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_sum_omp_r3 - - - SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_sum_omp_r4 - - - - SUBROUTINE reduce_min_omp_i(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: VarIn - INTEGER,INTENT(OUT) :: VarOut - INTEGER :: VarIn_tmp(1) - INTEGER :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL Check_buffer_i(1) - CALL reduce_min_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_min_omp_i - - SUBROUTINE reduce_min_omp_i1(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_min_omp_i1 - - - SUBROUTINE reduce_min_omp_i2(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_min_omp_i2 - - - SUBROUTINE reduce_min_omp_i3(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_min_omp_i3 - - - SUBROUTINE reduce_min_omp_i4(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_i(size(VarIn)) - CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) - - END SUBROUTINE reduce_min_omp_i4 - - - SUBROUTINE reduce_min_omp_r(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN) :: VarIn - REAL,INTENT(OUT) :: VarOut - REAL :: VarIn_tmp(1) - REAL :: VarOut_tmp(1) - - VarIn_tmp(1)=VarIn - CALL Check_buffer_r(1) - CALL reduce_min_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r) - VarOut=VarOut_tmp(1) - - END SUBROUTINE reduce_min_omp_r - - SUBROUTINE reduce_min_omp_r1(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_min_omp_r1 - - - SUBROUTINE reduce_min_omp_r2(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_min_omp_r2 - - - SUBROUTINE reduce_min_omp_r3(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_min_omp_r3 - - - SUBROUTINE reduce_min_omp_r4(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - CALL Check_buffer_r(size(VarIn)) - CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) - - END SUBROUTINE reduce_min_omp_r4 - - - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! LES ROUTINES GENERIQUES ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE bcast_omp_cgen(Var,Nb,Buff) - IMPLICIT NONE - - CHARACTER(LEN=*),INTENT(INOUT) :: Var - CHARACTER(LEN=*),INTENT(INOUT) :: Buff - INTEGER,INTENT(IN) :: Nb - - INTEGER :: i - - !$OMP MASTER - Buff=Var - !$OMP END MASTER - !$OMP BARRIER - - DO i=1,Nb - Var=Buff - ENDDO - !$OMP BARRIER - - END SUBROUTINE bcast_omp_cgen - - - - SUBROUTINE bcast_omp_igen(Var,Nb,Buff) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: Nb - INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var - INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff - - INTEGER :: i - - !$OMP MASTER - DO i=1,Nb - Buff(i)=Var(i) - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - DO i=1,Nb - Var(i)=Buff(i) - ENDDO - !$OMP BARRIER - - END SUBROUTINE bcast_omp_igen - - - SUBROUTINE bcast_omp_rgen(Var,Nb,Buff) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: Nb - REAL,DIMENSION(Nb),INTENT(INOUT) :: Var - REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff - - INTEGER :: i - - !$OMP MASTER - DO i=1,Nb - Buff(i)=Var(i) - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - DO i=1,Nb - Var(i)=Buff(i) - ENDDO - !$OMP BARRIER - - END SUBROUTINE bcast_omp_rgen - - SUBROUTINE bcast_omp_lgen(Var,Nb,Buff) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: Nb - LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var - LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff - - INTEGER :: i - - !$OMP MASTER - DO i=1,Nb - Buff(i)=Var(i) - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - DO i=1,Nb - Var(i)=Buff(i) - ENDDO - !$OMP BARRIER - - END SUBROUTINE bcast_omp_lgen - - - SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff) - USE mod_phys_lmdz_omp_data - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut - INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff - - INTEGER :: i,ij - - !$OMP MASTER - DO i=1,dimsize - DO ij=1,klon_mpi - Buff(ij,i)=VarIn(ij,i) - ENDDO - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - DO i=1,dimsize - DO ij=1,klon_omp - VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i) - ENDDO - ENDDO - !$OMP BARRIER - - END SUBROUTINE scatter_omp_igen - - - SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff) - USE mod_phys_lmdz_omp_data - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut - REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff - - INTEGER :: i,ij - - !$OMP MASTER - DO i=1,dimsize - DO ij=1,klon_mpi - Buff(ij,i)=VarIn(ij,i) - ENDDO - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - DO i=1,dimsize - DO ij=1,klon_omp - VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i) - ENDDO - ENDDO - !$OMP BARRIER - - END SUBROUTINE scatter_omp_rgen - - - SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff) - USE mod_phys_lmdz_omp_data - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut - LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff - - INTEGER :: i,ij - - !$OMP MASTER - DO i=1,dimsize - DO ij=1,klon_mpi - Buff(ij,i)=VarIn(ij,i) - ENDDO - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - DO i=1,dimsize - DO ij=1,klon_omp - VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i) - ENDDO - ENDDO - !$OMP BARRIER - - END SUBROUTINE scatter_omp_lgen - - - - - - SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff) - USE mod_phys_lmdz_omp_data - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff - - INTEGER :: i,ij - - DO i=1,dimsize - DO ij=1,klon_omp - Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i) - ENDDO - ENDDO - !$OMP BARRIER - - - !$OMP MASTER - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij,i)=Buff(ij,i) - ENDDO - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - END SUBROUTINE gather_omp_igen - - - SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize) - USE mod_phys_lmdz_omp_data - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize),TARGET :: VarOut - - REAL, POINTER, SAVE :: Varout_ptr(:,:) ! Shared between threads NOT THREADPRIVATE - - INTEGER :: i,ij - - !$omp master - Varout_ptr => VarOut - !$omp end master - !$omp barrier - - DO i=1,dimsize - DO ij=1,klon_omp - Varout_ptr(klon_omp_begin-1+ij,i)=VarIn(ij,i) - ENDDO - ENDDO - !$omp barrier - END SUBROUTINE gather_omp_rgen - - - SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff) - USE mod_phys_lmdz_omp_data - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut - LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff - - INTEGER :: i,ij - - DO i=1,dimsize - DO ij=1,klon_omp - Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i) - ENDDO - ENDDO - !$OMP BARRIER - - - !$OMP MASTER - DO i=1,dimsize - DO ij=1,klon_mpi - VarOut(ij,i)=Buff(ij,i) - ENDDO - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - END SUBROUTINE gather_omp_lgen - - - SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut - INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff - - INTEGER :: i - - !$OMP MASTER - Buff(:)=0 - !$OMP END MASTER - !$OMP BARRIER - - !$OMP CRITICAL - DO i=1,dimsize - Buff(i)=Buff(i)+VarIn(i) - ENDDO - !$OMP END CRITICAL - !$OMP BARRIER - - !$OMP MASTER - DO i=1,dimsize - VarOut(i)=Buff(i) - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - END SUBROUTINE reduce_sum_omp_igen - - SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut - REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff - - INTEGER :: i - - !$OMP MASTER - Buff(:)=0 - !$OMP END MASTER - !$OMP BARRIER - - !$OMP CRITICAL - DO i=1,dimsize - Buff(i)=Buff(i)+VarIn(i) - ENDDO - !$OMP END CRITICAL - !$OMP BARRIER - - !$OMP MASTER - DO i=1,dimsize - VarOut(i)=Buff(i) - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - END SUBROUTINE reduce_sum_omp_rgen - - - SUBROUTINE reduce_min_omp_igen(VarIn,VarOut,dimsize,Buff) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut - INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff - - INTEGER :: i - INTEGER :: var - - !$OMP MASTER - Buff(:)=HUGE(var) - !$OMP END MASTER - !$OMP BARRIER - - !$OMP CRITICAL - DO i=1,dimsize - Buff(i)=MIN(Buff(i),VarIn(i)) - ENDDO - !$OMP END CRITICAL - !$OMP BARRIER - - !$OMP MASTER - DO i=1,dimsize - VarOut(i)=Buff(i) - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - END SUBROUTINE reduce_min_omp_igen - - SUBROUTINE reduce_min_omp_rgen(VarIn,VarOut,dimsize,Buff) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: dimsize - REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn - REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut - REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff - - INTEGER :: i - REAL :: var - - !$OMP MASTER - Buff(:)=HUGE(var) - !$OMP END MASTER - !$OMP BARRIER - - !$OMP CRITICAL - DO i=1,dimsize - Buff(i)=MIN(Buff(i),VarIn(i)) - ENDDO - !$OMP END CRITICAL - !$OMP BARRIER - - !$OMP MASTER - DO i=1,dimsize - VarOut(i)=Buff(i) - ENDDO - !$OMP END MASTER - !$OMP BARRIER - - END SUBROUTINE reduce_min_omp_rgen - - -END MODULE mod_phys_lmdz_omp_transfert Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.f90 (revision 5268) @@ -0,0 +1,1256 @@ +! +!$Header$ +! +MODULE mod_phys_lmdz_omp_transfert + + PRIVATE + + REAL,PARAMETER :: grow_factor=1.5 + INTEGER,PARAMETER :: size_min=1024 + + CHARACTER(LEN=size_min),SAVE :: buffer_c +! INTEGER,SAVE :: size_c=0 + INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_i + INTEGER,SAVE :: size_i=0 + REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_r + INTEGER,SAVE :: size_r=0 + LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_l + INTEGER,SAVE :: size_l=0 + + + + + INTERFACE bcast_omp + MODULE PROCEDURE bcast_omp_c, & + bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, & + bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, & + bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4 + END INTERFACE + + INTERFACE scatter_omp + MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, & + scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, & + scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3 + END INTERFACE + + + INTERFACE gather_omp + MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, & + gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, & + gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3 + END INTERFACE + + + INTERFACE reduce_sum_omp + MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, & + reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4 + END INTERFACE + + INTERFACE reduce_min_omp + MODULE PROCEDURE reduce_min_omp_i,reduce_min_omp_i1,reduce_min_omp_i2,reduce_min_omp_i3,reduce_min_omp_i4, & + reduce_min_omp_r,reduce_min_omp_r1,reduce_min_omp_r2,reduce_min_omp_r3,reduce_min_omp_r4 + END INTERFACE + + + PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, reduce_min_omp, omp_barrier + +CONTAINS + + SUBROUTINE omp_barrier + IMPLICIT NONE + +!$OMP BARRIER + + END SUBROUTINE omp_barrier + + SUBROUTINE check_buffer_i(buff_size) + IMPLICIT NONE + INTEGER :: buff_size + +!$OMP BARRIER +!$OMP MASTER + IF (buff_size>size_i) THEN + IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i) + size_i=MAX(size_min,INT(grow_factor*buff_size)) + ALLOCATE(buffer_i(size_i)) + ENDIF +!$OMP END MASTER +!$OMP BARRIER + + END SUBROUTINE check_buffer_i + + SUBROUTINE check_buffer_r(buff_size) + IMPLICIT NONE + INTEGER :: buff_size + +!$OMP BARRIER +!$OMP MASTER + IF (buff_size>size_r) THEN + IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r) + size_r=MAX(size_min,INT(grow_factor*buff_size)) + ALLOCATE(buffer_r(size_r)) + ENDIF +!$OMP END MASTER +!$OMP BARRIER + + END SUBROUTINE check_buffer_r + + SUBROUTINE check_buffer_l(buff_size) + IMPLICIT NONE + INTEGER :: buff_size + +!$OMP BARRIER +!$OMP MASTER + IF (buff_size>size_l) THEN + IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l) + size_l=MAX(size_min,INT(grow_factor*buff_size)) + ALLOCATE(buffer_l(size_l)) + ENDIF +!$OMP END MASTER +!$OMP BARRIER + + END SUBROUTINE check_buffer_l + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Broadcast --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! -- Les chaine de charactère -- !! + + SUBROUTINE bcast_omp_c(var) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(INOUT) :: Var + + CALL bcast_omp_cgen(Var,len(Var),buffer_c) + + END SUBROUTINE bcast_omp_c + +!! -- Les entiers -- !! + + SUBROUTINE bcast_omp_i(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var + INTEGER :: Var_tmp(1) + + Var_tmp(1)=Var + CALL check_buffer_i(1) + CALL bcast_omp_igen(Var_tmp,1,buffer_i) + Var=Var_tmp(1) + + END SUBROUTINE bcast_omp_i + + + SUBROUTINE bcast_omp_i1(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:) + + CALL check_buffer_i(size(Var)) + CALL bcast_omp_igen(Var,size(Var),buffer_i) + + END SUBROUTINE bcast_omp_i1 + + + SUBROUTINE bcast_omp_i2(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:) + + CALL check_buffer_i(size(Var)) + CALL bcast_omp_igen(Var,size(Var),buffer_i) + + END SUBROUTINE bcast_omp_i2 + + + SUBROUTINE bcast_omp_i3(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:,:) + + CALL check_buffer_i(size(Var)) + CALL bcast_omp_igen(Var,size(Var),buffer_i) + + END SUBROUTINE bcast_omp_i3 + + + SUBROUTINE bcast_omp_i4(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:,:,:) + + CALL check_buffer_i(size(Var)) + CALL bcast_omp_igen(Var,size(Var),buffer_i) + + END SUBROUTINE bcast_omp_i4 + + +!! -- Les reels -- !! + + SUBROUTINE bcast_omp_r(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var + REAL :: Var_tmp(1) + + Var_tmp(1)=Var + CALL check_buffer_r(1) + CALL bcast_omp_rgen(Var_tmp,1,buffer_r) + Var=Var_tmp(1) + + END SUBROUTINE bcast_omp_r + + + SUBROUTINE bcast_omp_r1(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:) + + CALL check_buffer_r(size(Var)) + CALL bcast_omp_rgen(Var,size(Var),buffer_r) + + END SUBROUTINE bcast_omp_r1 + + + SUBROUTINE bcast_omp_r2(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:) + + CALL check_buffer_r(size(Var)) + CALL bcast_omp_rgen(Var,size(Var),buffer_r) + + END SUBROUTINE bcast_omp_r2 + + + SUBROUTINE bcast_omp_r3(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:,:) + + CALL check_buffer_r(size(Var)) + CALL bcast_omp_rgen(Var,size(Var),buffer_r) + + END SUBROUTINE bcast_omp_r3 + + + SUBROUTINE bcast_omp_r4(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:,:,:) + + CALL check_buffer_r(size(Var)) + CALL bcast_omp_rgen(Var,size(Var),buffer_r) + + END SUBROUTINE bcast_omp_r4 + + +!! -- Les booleans -- !! + + SUBROUTINE bcast_omp_l(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var + LOGICAL :: Var_tmp(1) + + Var_tmp(1)=Var + CALL check_buffer_l(1) + CALL bcast_omp_lgen(Var_tmp,1,buffer_l) + Var=Var_tmp(1) + + END SUBROUTINE bcast_omp_l + + + SUBROUTINE bcast_omp_l1(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:) + + CALL check_buffer_l(size(Var)) + CALL bcast_omp_lgen(Var,size(Var),buffer_l) + + END SUBROUTINE bcast_omp_l1 + + + SUBROUTINE bcast_omp_l2(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:) + + CALL check_buffer_l(size(Var)) + CALL bcast_omp_lgen(Var,size(Var),buffer_l) + + END SUBROUTINE bcast_omp_l2 + + + SUBROUTINE bcast_omp_l3(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:,:) + + CALL check_buffer_l(size(Var)) + CALL bcast_omp_lgen(Var,size(Var),buffer_l) + + END SUBROUTINE bcast_omp_l3 + + + SUBROUTINE bcast_omp_l4(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) + + CALL check_buffer_l(size(Var)) + CALL bcast_omp_lgen(Var,size(Var),buffer_l) + + END SUBROUTINE bcast_omp_l4 + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Scatter --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE scatter_omp_i(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL scatter_omp_igen(VarIn,Varout,1,buffer_i) + + END SUBROUTINE scatter_omp_i + + + SUBROUTINE scatter_omp_i1(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i) + + END SUBROUTINE scatter_omp_i1 + + + SUBROUTINE scatter_omp_i2(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i) + + END SUBROUTINE scatter_omp_i2 + + + SUBROUTINE scatter_omp_i3(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i) + + END SUBROUTINE scatter_omp_i3 + + + + + SUBROUTINE scatter_omp_r(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r) + + END SUBROUTINE scatter_omp_r + + + SUBROUTINE scatter_omp_r1(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r) + + END SUBROUTINE scatter_omp_r1 + + + SUBROUTINE scatter_omp_r2(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r) + + END SUBROUTINE scatter_omp_r2 + + + SUBROUTINE scatter_omp_r3(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r) + + END SUBROUTINE scatter_omp_r3 + + + + SUBROUTINE scatter_omp_l(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_l(size(VarIn)) + CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l) + + END SUBROUTINE scatter_omp_l + + + SUBROUTINE scatter_omp_l1(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_l(size(VarIn)) + CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l) + + END SUBROUTINE scatter_omp_l1 + + + SUBROUTINE scatter_omp_l2(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_l(size(VarIn)) + CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l) + + END SUBROUTINE scatter_omp_l2 + + + SUBROUTINE scatter_omp_l3(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_l(size(VarIn)) + CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l) + + END SUBROUTINE scatter_omp_l3 + + + SUBROUTINE gather_omp_i(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_i(size(VarOut)) + CALL gather_omp_igen(VarIn,Varout,1,buffer_i) + + END SUBROUTINE gather_omp_i + + + SUBROUTINE gather_omp_i1(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_i(size(VarOut)) + CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i) + + END SUBROUTINE gather_omp_i1 + + + SUBROUTINE gather_omp_i2(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarOut)) + CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i) + + END SUBROUTINE gather_omp_i2 + + + SUBROUTINE gather_omp_i3(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarOut)) + CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i) + + END SUBROUTINE gather_omp_i3 + + + + SUBROUTINE gather_omp_r(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL gather_omp_rgen(VarIn,Varout,1) + + END SUBROUTINE gather_omp_r + + + SUBROUTINE gather_omp_r1(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)) + + END SUBROUTINE gather_omp_r1 + + + SUBROUTINE gather_omp_r2(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)) + + END SUBROUTINE gather_omp_r2 + + + SUBROUTINE gather_omp_r3(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4)) + + END SUBROUTINE gather_omp_r3 + + + SUBROUTINE gather_omp_l(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_l(size(VarOut)) + CALL gather_omp_lgen(VarIn,Varout,1,buffer_l) + + END SUBROUTINE gather_omp_l + + + SUBROUTINE gather_omp_l1(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_l(size(VarOut)) + CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l) + + END SUBROUTINE gather_omp_l1 + + + SUBROUTINE gather_omp_l2(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_l(size(VarOut)) + CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l) + + END SUBROUTINE gather_omp_l2 + + + SUBROUTINE gather_omp_l3(VarIn, VarOut) + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_l(size(VarOut)) + CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l) + + END SUBROUTINE gather_omp_l3 + + + + + SUBROUTINE reduce_sum_omp_i(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: VarIn + INTEGER,INTENT(OUT) :: VarOut + INTEGER :: VarIn_tmp(1) + INTEGER :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL Check_buffer_i(1) + CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_sum_omp_i + + SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_sum_omp_i1 + + + SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_sum_omp_i2 + + + SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_sum_omp_i3 + + + SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_sum_omp_i4 + + + SUBROUTINE reduce_sum_omp_r(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN) :: VarIn + REAL,INTENT(OUT) :: VarOut + REAL :: VarIn_tmp(1) + REAL :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL Check_buffer_r(1) + CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_sum_omp_r + + SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_sum_omp_r1 + + + SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_sum_omp_r2 + + + SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_sum_omp_r3 + + + SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_sum_omp_r4 + + + + SUBROUTINE reduce_min_omp_i(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: VarIn + INTEGER,INTENT(OUT) :: VarOut + INTEGER :: VarIn_tmp(1) + INTEGER :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL Check_buffer_i(1) + CALL reduce_min_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_min_omp_i + + SUBROUTINE reduce_min_omp_i1(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_min_omp_i1 + + + SUBROUTINE reduce_min_omp_i2(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_min_omp_i2 + + + SUBROUTINE reduce_min_omp_i3(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_min_omp_i3 + + + SUBROUTINE reduce_min_omp_i4(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_i(size(VarIn)) + CALL reduce_min_omp_igen(VarIn,Varout,Size(VarIn),buffer_i) + + END SUBROUTINE reduce_min_omp_i4 + + + SUBROUTINE reduce_min_omp_r(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN) :: VarIn + REAL,INTENT(OUT) :: VarOut + REAL :: VarIn_tmp(1) + REAL :: VarOut_tmp(1) + + VarIn_tmp(1)=VarIn + CALL Check_buffer_r(1) + CALL reduce_min_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r) + VarOut=VarOut_tmp(1) + + END SUBROUTINE reduce_min_omp_r + + SUBROUTINE reduce_min_omp_r1(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_min_omp_r1 + + + SUBROUTINE reduce_min_omp_r2(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_min_omp_r2 + + + SUBROUTINE reduce_min_omp_r3(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_min_omp_r3 + + + SUBROUTINE reduce_min_omp_r4(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + CALL Check_buffer_r(size(VarIn)) + CALL reduce_min_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r) + + END SUBROUTINE reduce_min_omp_r4 + + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! LES ROUTINES GENERIQUES ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE bcast_omp_cgen(Var,Nb,Buff) + IMPLICIT NONE + + CHARACTER(LEN=*),INTENT(INOUT) :: Var + CHARACTER(LEN=*),INTENT(INOUT) :: Buff + INTEGER,INTENT(IN) :: Nb + + INTEGER :: i + + !$OMP MASTER + Buff=Var + !$OMP END MASTER + !$OMP BARRIER + + DO i=1,Nb + Var=Buff + ENDDO + !$OMP BARRIER + + END SUBROUTINE bcast_omp_cgen + + + + SUBROUTINE bcast_omp_igen(Var,Nb,Buff) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: Nb + INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var + INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff + + INTEGER :: i + + !$OMP MASTER + DO i=1,Nb + Buff(i)=Var(i) + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + DO i=1,Nb + Var(i)=Buff(i) + ENDDO + !$OMP BARRIER + + END SUBROUTINE bcast_omp_igen + + + SUBROUTINE bcast_omp_rgen(Var,Nb,Buff) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: Nb + REAL,DIMENSION(Nb),INTENT(INOUT) :: Var + REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff + + INTEGER :: i + + !$OMP MASTER + DO i=1,Nb + Buff(i)=Var(i) + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + DO i=1,Nb + Var(i)=Buff(i) + ENDDO + !$OMP BARRIER + + END SUBROUTINE bcast_omp_rgen + + SUBROUTINE bcast_omp_lgen(Var,Nb,Buff) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: Nb + LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var + LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff + + INTEGER :: i + + !$OMP MASTER + DO i=1,Nb + Buff(i)=Var(i) + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + DO i=1,Nb + Var(i)=Buff(i) + ENDDO + !$OMP BARRIER + + END SUBROUTINE bcast_omp_lgen + + + SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff) + USE mod_phys_lmdz_omp_data + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut + INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff + + INTEGER :: i,ij + + !$OMP MASTER + DO i=1,dimsize + DO ij=1,klon_mpi + Buff(ij,i)=VarIn(ij,i) + ENDDO + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + DO i=1,dimsize + DO ij=1,klon_omp + VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i) + ENDDO + ENDDO + !$OMP BARRIER + + END SUBROUTINE scatter_omp_igen + + + SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff) + USE mod_phys_lmdz_omp_data + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut + REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff + + INTEGER :: i,ij + + !$OMP MASTER + DO i=1,dimsize + DO ij=1,klon_mpi + Buff(ij,i)=VarIn(ij,i) + ENDDO + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + DO i=1,dimsize + DO ij=1,klon_omp + VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i) + ENDDO + ENDDO + !$OMP BARRIER + + END SUBROUTINE scatter_omp_rgen + + + SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff) + USE mod_phys_lmdz_omp_data + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut + LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff + + INTEGER :: i,ij + + !$OMP MASTER + DO i=1,dimsize + DO ij=1,klon_mpi + Buff(ij,i)=VarIn(ij,i) + ENDDO + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + DO i=1,dimsize + DO ij=1,klon_omp + VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i) + ENDDO + ENDDO + !$OMP BARRIER + + END SUBROUTINE scatter_omp_lgen + + + + + + SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff) + USE mod_phys_lmdz_omp_data + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff + + INTEGER :: i,ij + + DO i=1,dimsize + DO ij=1,klon_omp + Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i) + ENDDO + ENDDO + !$OMP BARRIER + + + !$OMP MASTER + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij,i)=Buff(ij,i) + ENDDO + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + END SUBROUTINE gather_omp_igen + + + SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize) + USE mod_phys_lmdz_omp_data + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize),TARGET :: VarOut + + REAL, POINTER, SAVE :: Varout_ptr(:,:) ! Shared between threads NOT THREADPRIVATE + + INTEGER :: i,ij + + !$omp master + Varout_ptr => VarOut + !$omp end master + !$omp barrier + + DO i=1,dimsize + DO ij=1,klon_omp + Varout_ptr(klon_omp_begin-1+ij,i)=VarIn(ij,i) + ENDDO + ENDDO + !$omp barrier + END SUBROUTINE gather_omp_rgen + + + SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff) + USE mod_phys_lmdz_omp_data + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut + LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff + + INTEGER :: i,ij + + DO i=1,dimsize + DO ij=1,klon_omp + Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i) + ENDDO + ENDDO + !$OMP BARRIER + + + !$OMP MASTER + DO i=1,dimsize + DO ij=1,klon_mpi + VarOut(ij,i)=Buff(ij,i) + ENDDO + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + END SUBROUTINE gather_omp_lgen + + + SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut + INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff + + INTEGER :: i + + !$OMP MASTER + Buff(:)=0 + !$OMP END MASTER + !$OMP BARRIER + + !$OMP CRITICAL + DO i=1,dimsize + Buff(i)=Buff(i)+VarIn(i) + ENDDO + !$OMP END CRITICAL + !$OMP BARRIER + + !$OMP MASTER + DO i=1,dimsize + VarOut(i)=Buff(i) + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + END SUBROUTINE reduce_sum_omp_igen + + SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut + REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff + + INTEGER :: i + + !$OMP MASTER + Buff(:)=0 + !$OMP END MASTER + !$OMP BARRIER + + !$OMP CRITICAL + DO i=1,dimsize + Buff(i)=Buff(i)+VarIn(i) + ENDDO + !$OMP END CRITICAL + !$OMP BARRIER + + !$OMP MASTER + DO i=1,dimsize + VarOut(i)=Buff(i) + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + END SUBROUTINE reduce_sum_omp_rgen + + + SUBROUTINE reduce_min_omp_igen(VarIn,VarOut,dimsize,Buff) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut + INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff + + INTEGER :: i + INTEGER :: var + + !$OMP MASTER + Buff(:)=HUGE(var) + !$OMP END MASTER + !$OMP BARRIER + + !$OMP CRITICAL + DO i=1,dimsize + Buff(i)=MIN(Buff(i),VarIn(i)) + ENDDO + !$OMP END CRITICAL + !$OMP BARRIER + + !$OMP MASTER + DO i=1,dimsize + VarOut(i)=Buff(i) + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + END SUBROUTINE reduce_min_omp_igen + + SUBROUTINE reduce_min_omp_rgen(VarIn,VarOut,dimsize,Buff) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: dimsize + REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn + REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut + REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff + + INTEGER :: i + REAL :: var + + !$OMP MASTER + Buff(:)=HUGE(var) + !$OMP END MASTER + !$OMP BARRIER + + !$OMP CRITICAL + DO i=1,dimsize + Buff(i)=MIN(Buff(i),VarIn(i)) + ENDDO + !$OMP END CRITICAL + !$OMP BARRIER + + !$OMP MASTER + DO i=1,dimsize + VarOut(i)=Buff(i) + ENDDO + !$OMP END MASTER + !$OMP BARRIER + + END SUBROUTINE reduce_min_omp_rgen + + +END MODULE mod_phys_lmdz_omp_transfert Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.F90 (revision 5267) +++ (revision ) @@ -1,120 +1,0 @@ -! -! $Id$ -! -MODULE mod_phys_lmdz_para - USE mod_phys_lmdz_transfert_para - USE mod_phys_lmdz_mpi_data - USE mod_phys_lmdz_omp_data - - INTEGER,SAVE :: klon_loc - LOGICAL,SAVE :: is_sequential - LOGICAL,SAVE :: is_parallel - LOGICAL,SAVE :: is_master - - -!$OMP THREADPRIVATE(klon_loc,is_master) - -CONTAINS - - SUBROUTINE Init_phys_lmdz_para(nbp,nbp_lon,nbp_lat,nbp_lev,grid_type, nvertex,communicator) - IMPLICIT NONE - INTEGER,INTENT(in) :: nbp - INTEGER,INTENT(in) :: nbp_lon - INTEGER,INTENT(in) :: nbp_lat - INTEGER,INTENT(in) :: nbp_lev - INTEGER,INTENT(in) :: communicator - INTEGER,INTENT(IN) :: grid_type - INTEGER,INTENT(IN) :: nvertex - - CALL Init_phys_lmdz_mpi_data(nbp,nbp_lon,nbp_lat,nbp_lev, grid_type, nvertex,communicator) -!$OMP PARALLEL - CALL Init_phys_lmdz_omp_data(klon_mpi) - klon_loc=klon_omp - IF (is_mpi_root .AND. is_omp_root) THEN - is_master=.TRUE. - ELSE - is_master=.FALSE. - ENDIF -!ym CALL Test_transfert -!$OMP END PARALLEL - IF (is_using_mpi .OR. is_using_omp) THEN - is_sequential=.FALSE. - is_parallel=.TRUE. - ELSE - is_sequential=.TRUE. - is_parallel=.FALSE. - ENDIF - - - - END SUBROUTINE Init_phys_lmdz_para - - SUBROUTINE Test_transfert - USE mod_grid_phy_lmdz - USE print_control_mod, ONLY: lunout - IMPLICIT NONE -! INCLUDE "iniprint.h" - - REAL :: Test_Field1d_glo(klon_glo,nbp_lev) - REAL :: tmp1d_glo(klon_glo,nbp_lev) - REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev) - REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev) - REAL :: Test_Field1d_loc(klon_loc,nbp_lev) - REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev) - REAL :: CheckSum - - INTEGER :: i,l - - Test_Field1d_glo = 0. - Test_Field2d_glo = 0. - Test_Field1d_loc = 0. - Test_Field2d_loc = 0. - - IF (is_mpi_root) THEN -!$OMP MASTER - DO l=1,nbp_lev - DO i=1,klon_glo -! Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1) - Test_Field1d_glo(i,l)=1 - ENDDO - ENDDO -!$OMP END MASTER - ENDIF - - CALL Scatter(Test_Field1d_glo,Test_Field1d_loc) - CALL Gather(Test_Field1d_loc,tmp1d_glo) - - IF (is_mpi_root) THEN -!$OMP MASTER - Checksum=sum(Test_Field1d_glo-tmp1d_glo) - WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0" -!$OMP END MASTER - ENDIF - - CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo) - CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc) - CALL gather2d(Test_Field1d_loc,Test_Field2d_glo) - CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo) - - IF (is_mpi_root) THEN -!$OMP MASTER - Checksum=sum(Test_Field1d_glo-tmp1d_glo) - WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0" -!$OMP END MASTER - ENDIF - - CALL bcast(Test_Field1d_glo) - CALL reduce_sum(Test_Field1d_glo,tmp1d_glo) - - IF (is_mpi_root) THEN -!$OMP MASTER - Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo) - WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0" -!$OMP END MASTER - ENDIF - - - END SUBROUTINE Test_transfert - -END MODULE mod_phys_lmdz_para - Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.f90 (revision 5268) @@ -0,0 +1,120 @@ +! +! $Id$ +! +MODULE mod_phys_lmdz_para + USE mod_phys_lmdz_transfert_para + USE mod_phys_lmdz_mpi_data + USE mod_phys_lmdz_omp_data + + INTEGER,SAVE :: klon_loc + LOGICAL,SAVE :: is_sequential + LOGICAL,SAVE :: is_parallel + LOGICAL,SAVE :: is_master + + +!$OMP THREADPRIVATE(klon_loc,is_master) + +CONTAINS + + SUBROUTINE Init_phys_lmdz_para(nbp,nbp_lon,nbp_lat,nbp_lev,grid_type, nvertex,communicator) + IMPLICIT NONE + INTEGER,INTENT(in) :: nbp + INTEGER,INTENT(in) :: nbp_lon + INTEGER,INTENT(in) :: nbp_lat + INTEGER,INTENT(in) :: nbp_lev + INTEGER,INTENT(in) :: communicator + INTEGER,INTENT(IN) :: grid_type + INTEGER,INTENT(IN) :: nvertex + + CALL Init_phys_lmdz_mpi_data(nbp,nbp_lon,nbp_lat,nbp_lev, grid_type, nvertex,communicator) +!$OMP PARALLEL + CALL Init_phys_lmdz_omp_data(klon_mpi) + klon_loc=klon_omp + IF (is_mpi_root .AND. is_omp_root) THEN + is_master=.TRUE. + ELSE + is_master=.FALSE. + ENDIF +!ym CALL Test_transfert +!$OMP END PARALLEL + IF (is_using_mpi .OR. is_using_omp) THEN + is_sequential=.FALSE. + is_parallel=.TRUE. + ELSE + is_sequential=.TRUE. + is_parallel=.FALSE. + ENDIF + + + + END SUBROUTINE Init_phys_lmdz_para + + SUBROUTINE Test_transfert + USE mod_grid_phy_lmdz + USE print_control_mod, ONLY: lunout + IMPLICIT NONE +! INCLUDE "iniprint.h" + + REAL :: Test_Field1d_glo(klon_glo,nbp_lev) + REAL :: tmp1d_glo(klon_glo,nbp_lev) + REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev) + REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev) + REAL :: Test_Field1d_loc(klon_loc,nbp_lev) + REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev) + REAL :: CheckSum + + INTEGER :: i,l + + Test_Field1d_glo = 0. + Test_Field2d_glo = 0. + Test_Field1d_loc = 0. + Test_Field2d_loc = 0. + + IF (is_mpi_root) THEN +!$OMP MASTER + DO l=1,nbp_lev + DO i=1,klon_glo +! Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1) + Test_Field1d_glo(i,l)=1 + ENDDO + ENDDO +!$OMP END MASTER + ENDIF + + CALL Scatter(Test_Field1d_glo,Test_Field1d_loc) + CALL Gather(Test_Field1d_loc,tmp1d_glo) + + IF (is_mpi_root) THEN +!$OMP MASTER + Checksum=sum(Test_Field1d_glo-tmp1d_glo) + WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0" +!$OMP END MASTER + ENDIF + + CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo) + CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc) + CALL gather2d(Test_Field1d_loc,Test_Field2d_glo) + CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo) + + IF (is_mpi_root) THEN +!$OMP MASTER + Checksum=sum(Test_Field1d_glo-tmp1d_glo) + WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0" +!$OMP END MASTER + ENDIF + + CALL bcast(Test_Field1d_glo) + CALL reduce_sum(Test_Field1d_glo,tmp1d_glo) + + IF (is_mpi_root) THEN +!$OMP MASTER + Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo) + WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0" +!$OMP END MASTER + ENDIF + + + END SUBROUTINE Test_transfert + +END MODULE mod_phys_lmdz_para + Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_transfert_para.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_transfert_para.F90 (revision 5267) +++ (revision ) @@ -1,1448 +1,0 @@ -! -!$Id$ -! -MODULE mod_phys_lmdz_transfert_para - - USE mod_phys_lmdz_mpi_transfert - USE mod_phys_lmdz_omp_transfert - - - - INTERFACE bcast - MODULE PROCEDURE bcast_c, & - bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, & - bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, & - bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4 - END INTERFACE - - INTERFACE scatter - MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, & - scatter_r,scatter_r1,scatter_r2,scatter_r3, & - scatter_l,scatter_l1,scatter_l2,scatter_l3 - END INTERFACE - - - INTERFACE gather - MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, & - gather_r,gather_r1,gather_r2,gather_r3, & - gather_l,gather_l1,gather_l2,gather_l3 - END INTERFACE - - INTERFACE scatter2D - MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, & - scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, & - scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3 - END INTERFACE - - INTERFACE gather2D - MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, & - gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, & - gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3 - END INTERFACE - - INTERFACE reduce_sum - MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, & - reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4 - END INTERFACE - - INTERFACE reduce_min - MODULE PROCEDURE reduce_min_i,reduce_min_i1,reduce_min_i2,reduce_min_i3,reduce_min_i4, & - reduce_min_r,reduce_min_r1,reduce_min_r2,reduce_min_r3,reduce_min_r4 - END INTERFACE - -CONTAINS - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Broadcast --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!! -- Les chaine de charactère -- !! - - SUBROUTINE bcast_c(var) - IMPLICIT NONE - CHARACTER(LEN=*),INTENT(INOUT) :: Var - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_c - -!! -- Les entiers -- !! - - SUBROUTINE bcast_i(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_i - - SUBROUTINE bcast_i1(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_i1 - - - SUBROUTINE bcast_i2(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_i2 - - - SUBROUTINE bcast_i3(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_i3 - - - SUBROUTINE bcast_i4(var) - IMPLICIT NONE - INTEGER,INTENT(INOUT) :: Var(:,:,:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_i4 - - -!! -- Les reels -- !! - - SUBROUTINE bcast_r(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_r - - SUBROUTINE bcast_r1(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_r1 - - - SUBROUTINE bcast_r2(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_r2 - - - SUBROUTINE bcast_r3(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_r3 - - - SUBROUTINE bcast_r4(var) - IMPLICIT NONE - REAL,INTENT(INOUT) :: Var(:,:,:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_r4 - - -!! -- Les booleens -- !! - - SUBROUTINE bcast_l(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_l - - SUBROUTINE bcast_l1(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_l1 - - - SUBROUTINE bcast_l2(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_l2 - - - SUBROUTINE bcast_l3(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_l3 - - - SUBROUTINE bcast_l4(var) - IMPLICIT NONE - LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) - -!$OMP MASTER - CALL bcast_mpi(Var) -!$OMP END MASTER - CALL bcast_omp(Var) - - END SUBROUTINE bcast_l4 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Scatter --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE scatter_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - INTEGER,DIMENSION(klon_mpi) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_i - - - SUBROUTINE scatter_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_i1 - - - SUBROUTINE scatter_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_i2 - - - SUBROUTINE scatter_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter_i3 - - - SUBROUTINE scatter_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - REAL,DIMENSION(klon_mpi) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_r - - - SUBROUTINE scatter_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_r1 - - - SUBROUTINE scatter_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_r2 - - - SUBROUTINE scatter_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter_r3 - - - - SUBROUTINE scatter_l(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_l - - - SUBROUTINE scatter_l1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_l1 - - - SUBROUTINE scatter_l2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,Varout) - - END SUBROUTINE scatter_l2 - - - SUBROUTINE scatter_l3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp - -!$OMP MASTER - CALL scatter_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter_l3 - - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Gather --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!!!!! --> Les entiers - - SUBROUTINE gather_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - INTEGER, DIMENSION(klon_mpi) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,Varout) -!$OMP END MASTER - - END SUBROUTINE gather_i - - - SUBROUTINE gather_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,Varout) -!$OMP END MASTER - - END SUBROUTINE gather_i1 - - - SUBROUTINE gather_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_i2 - - - SUBROUTINE gather_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_i3 - - -!!!!! --> Les reels - - SUBROUTINE gather_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - REAL, DIMENSION(klon_mpi) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_r - - - SUBROUTINE gather_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_r1 - - - SUBROUTINE gather_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_r2 - - - SUBROUTINE gather_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_r3 - - -!!!!! --> Les booleens - - SUBROUTINE gather_l(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - LOGICAL, DIMENSION(klon_mpi) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_l - - - SUBROUTINE gather_l1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_l1 - - - SUBROUTINE gather_l2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_l2 - - - SUBROUTINE gather_l3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather_l3 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Scatter2D --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - -!!!!! --> Les entiers - - SUBROUTINE scatter2D_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - INTEGER,DIMENSION(klon_mpi) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_i - - - SUBROUTINE scatter2D_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_i1 - - - SUBROUTINE scatter2D_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_i2 - - - SUBROUTINE scatter2D_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_i3 - - -!!!!! --> Les reels - - SUBROUTINE scatter2D_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - REAL,DIMENSION(klon_mpi) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_r - - - SUBROUTINE scatter2D_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_r1 - - - SUBROUTINE scatter2D_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_r2 - - - SUBROUTINE scatter2D_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_r3 - - -!!!!! --> Les booleens - - - SUBROUTINE scatter2D_l(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_l - - - SUBROUTINE scatter2D_l1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_l1 - - - SUBROUTINE scatter2D_l2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_l2 - - - SUBROUTINE scatter2D_l3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp - -!$OMP MASTER - CALL scatter2D_mpi(VarIn,Var_tmp) -!$OMP END MASTER - CALL scatter_omp(Var_tmp,VarOut) - - END SUBROUTINE scatter2D_l3 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des Gather2D --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!!!!! --> Les entiers - - SUBROUTINE gather2D_i(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_i - - - SUBROUTINE gather2D_i1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_i1 - - - SUBROUTINE gather2D_i2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_i2 - - - SUBROUTINE gather2D_i3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_i3 - - -!!!!! --> Les reels - - SUBROUTINE gather2D_r(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL,DIMENSION(klon_mpi) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_r - - - SUBROUTINE gather2D_r1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_r1 - - - SUBROUTINE gather2D_r2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_r2 - - - SUBROUTINE gather2D_r3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_r3 - - -!!!!! --> Les booleens - - SUBROUTINE gather2D_l(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_l - - - SUBROUTINE gather2D_l1(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_l1 - - - SUBROUTINE gather2D_l2(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_l2 - - - SUBROUTINE gather2D_l3(VarIn, VarOut) - USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi - IMPLICIT NONE - - LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut - - LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL gather_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL gather2D_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE gather2D_l3 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des reduce_sum --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Les entiers - - SUBROUTINE reduce_sum_i(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: VarIn - INTEGER,INTENT(OUT) :: VarOut - - INTEGER :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_i - - - SUBROUTINE reduce_sum_i1(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_i1 - - - SUBROUTINE reduce_sum_i2(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_i2 - - - SUBROUTINE reduce_sum_i3(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_i3 - - - SUBROUTINE reduce_sum_i4(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_i4 - - -! Les reels - - SUBROUTINE reduce_sum_r(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN) :: VarIn - REAL,INTENT(OUT) :: VarOut - - REAL :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_r - - - SUBROUTINE reduce_sum_r1(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_r1 - - - SUBROUTINE reduce_sum_r2(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_r2 - - - SUBROUTINE reduce_sum_r3(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_r3 - - - SUBROUTINE reduce_sum_r4(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL reduce_sum_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_sum_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_sum_r4 - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Definition des reduce_min --> 4D !! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Les entiers - - SUBROUTINE reduce_min_i(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN) :: VarIn - INTEGER,INTENT(OUT) :: VarOut - - INTEGER :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_i - - - SUBROUTINE reduce_min_i1(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_i1 - - - SUBROUTINE reduce_min_i2(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_i2 - - - SUBROUTINE reduce_min_i3(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_i3 - - - SUBROUTINE reduce_min_i4(VarIn, VarOut) - IMPLICIT NONE - - INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_i4 - - -! Les reels - - SUBROUTINE reduce_min_r(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN) :: VarIn - REAL,INTENT(OUT) :: VarOut - - REAL :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_r - - - SUBROUTINE reduce_min_r1(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_r1 - - - SUBROUTINE reduce_min_r2(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_r2 - - - SUBROUTINE reduce_min_r3(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_r3 - - - SUBROUTINE reduce_min_r4(VarIn, VarOut) - IMPLICIT NONE - - REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn - REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut - - REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp - - CALL reduce_min_omp(VarIn,Var_tmp) -!$OMP MASTER - CALL reduce_min_mpi(Var_tmp,VarOut) -!$OMP END MASTER - - END SUBROUTINE reduce_min_r4 - - - -END MODULE mod_phys_lmdz_transfert_para - Index: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_transfert_para.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_transfert_para.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_transfert_para.f90 (revision 5268) @@ -0,0 +1,1448 @@ +! +!$Id$ +! +MODULE mod_phys_lmdz_transfert_para + + USE mod_phys_lmdz_mpi_transfert + USE mod_phys_lmdz_omp_transfert + + + + INTERFACE bcast + MODULE PROCEDURE bcast_c, & + bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, & + bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, & + bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4 + END INTERFACE + + INTERFACE scatter + MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, & + scatter_r,scatter_r1,scatter_r2,scatter_r3, & + scatter_l,scatter_l1,scatter_l2,scatter_l3 + END INTERFACE + + + INTERFACE gather + MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, & + gather_r,gather_r1,gather_r2,gather_r3, & + gather_l,gather_l1,gather_l2,gather_l3 + END INTERFACE + + INTERFACE scatter2D + MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, & + scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, & + scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3 + END INTERFACE + + INTERFACE gather2D + MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, & + gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, & + gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3 + END INTERFACE + + INTERFACE reduce_sum + MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, & + reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4 + END INTERFACE + + INTERFACE reduce_min + MODULE PROCEDURE reduce_min_i,reduce_min_i1,reduce_min_i2,reduce_min_i3,reduce_min_i4, & + reduce_min_r,reduce_min_r1,reduce_min_r2,reduce_min_r3,reduce_min_r4 + END INTERFACE + +CONTAINS + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Broadcast --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! -- Les chaine de charactère -- !! + + SUBROUTINE bcast_c(var) + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(INOUT) :: Var + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_c + +!! -- Les entiers -- !! + + SUBROUTINE bcast_i(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_i + + SUBROUTINE bcast_i1(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_i1 + + + SUBROUTINE bcast_i2(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_i2 + + + SUBROUTINE bcast_i3(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_i3 + + + SUBROUTINE bcast_i4(var) + IMPLICIT NONE + INTEGER,INTENT(INOUT) :: Var(:,:,:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_i4 + + +!! -- Les reels -- !! + + SUBROUTINE bcast_r(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_r + + SUBROUTINE bcast_r1(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_r1 + + + SUBROUTINE bcast_r2(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_r2 + + + SUBROUTINE bcast_r3(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_r3 + + + SUBROUTINE bcast_r4(var) + IMPLICIT NONE + REAL,INTENT(INOUT) :: Var(:,:,:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_r4 + + +!! -- Les booleens -- !! + + SUBROUTINE bcast_l(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_l + + SUBROUTINE bcast_l1(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_l1 + + + SUBROUTINE bcast_l2(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_l2 + + + SUBROUTINE bcast_l3(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_l3 + + + SUBROUTINE bcast_l4(var) + IMPLICIT NONE + LOGICAL,INTENT(INOUT) :: Var(:,:,:,:) + +!$OMP MASTER + CALL bcast_mpi(Var) +!$OMP END MASTER + CALL bcast_omp(Var) + + END SUBROUTINE bcast_l4 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Scatter --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE scatter_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + INTEGER,DIMENSION(klon_mpi) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_i + + + SUBROUTINE scatter_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_i1 + + + SUBROUTINE scatter_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_i2 + + + SUBROUTINE scatter_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter_i3 + + + SUBROUTINE scatter_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + REAL,DIMENSION(klon_mpi) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_r + + + SUBROUTINE scatter_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_r1 + + + SUBROUTINE scatter_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_r2 + + + SUBROUTINE scatter_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter_r3 + + + + SUBROUTINE scatter_l(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_l + + + SUBROUTINE scatter_l1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_l1 + + + SUBROUTINE scatter_l2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,Varout) + + END SUBROUTINE scatter_l2 + + + SUBROUTINE scatter_l3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp + +!$OMP MASTER + CALL scatter_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter_l3 + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Gather --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!! --> Les entiers + + SUBROUTINE gather_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + INTEGER, DIMENSION(klon_mpi) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,Varout) +!$OMP END MASTER + + END SUBROUTINE gather_i + + + SUBROUTINE gather_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,Varout) +!$OMP END MASTER + + END SUBROUTINE gather_i1 + + + SUBROUTINE gather_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_i2 + + + SUBROUTINE gather_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_i3 + + +!!!!! --> Les reels + + SUBROUTINE gather_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + REAL, DIMENSION(klon_mpi) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_r + + + SUBROUTINE gather_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_r1 + + + SUBROUTINE gather_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_r2 + + + SUBROUTINE gather_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_r3 + + +!!!!! --> Les booleens + + SUBROUTINE gather_l(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + LOGICAL, DIMENSION(klon_mpi) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_l + + + SUBROUTINE gather_l1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_l1 + + + SUBROUTINE gather_l2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_l2 + + + SUBROUTINE gather_l3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather_l3 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Scatter2D --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +!!!!! --> Les entiers + + SUBROUTINE scatter2D_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + INTEGER,DIMENSION(klon_mpi) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_i + + + SUBROUTINE scatter2D_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_i1 + + + SUBROUTINE scatter2D_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_i2 + + + SUBROUTINE scatter2D_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_i3 + + +!!!!! --> Les reels + + SUBROUTINE scatter2D_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + REAL,DIMENSION(klon_mpi) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_r + + + SUBROUTINE scatter2D_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_r1 + + + SUBROUTINE scatter2D_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_r2 + + + SUBROUTINE scatter2D_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_r3 + + +!!!!! --> Les booleens + + + SUBROUTINE scatter2D_l(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_l + + + SUBROUTINE scatter2D_l1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_l1 + + + SUBROUTINE scatter2D_l2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_l2 + + + SUBROUTINE scatter2D_l3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp + +!$OMP MASTER + CALL scatter2D_mpi(VarIn,Var_tmp) +!$OMP END MASTER + CALL scatter_omp(Var_tmp,VarOut) + + END SUBROUTINE scatter2D_l3 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des Gather2D --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!! --> Les entiers + + SUBROUTINE gather2D_i(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_i + + + SUBROUTINE gather2D_i1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_i1 + + + SUBROUTINE gather2D_i2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_i2 + + + SUBROUTINE gather2D_i3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_i3 + + +!!!!! --> Les reels + + SUBROUTINE gather2D_r(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL,DIMENSION(klon_mpi) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_r + + + SUBROUTINE gather2D_r1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_r1 + + + SUBROUTINE gather2D_r2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_r2 + + + SUBROUTINE gather2D_r3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_r3 + + +!!!!! --> Les booleens + + SUBROUTINE gather2D_l(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_l + + + SUBROUTINE gather2D_l1(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_l1 + + + SUBROUTINE gather2D_l2(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_l2 + + + SUBROUTINE gather2D_l3(VarIn, VarOut) + USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi + IMPLICIT NONE + + LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut + + LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL gather_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL gather2D_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE gather2D_l3 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des reduce_sum --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Les entiers + + SUBROUTINE reduce_sum_i(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: VarIn + INTEGER,INTENT(OUT) :: VarOut + + INTEGER :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_i + + + SUBROUTINE reduce_sum_i1(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_i1 + + + SUBROUTINE reduce_sum_i2(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_i2 + + + SUBROUTINE reduce_sum_i3(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_i3 + + + SUBROUTINE reduce_sum_i4(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_i4 + + +! Les reels + + SUBROUTINE reduce_sum_r(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN) :: VarIn + REAL,INTENT(OUT) :: VarOut + + REAL :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_r + + + SUBROUTINE reduce_sum_r1(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_r1 + + + SUBROUTINE reduce_sum_r2(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_r2 + + + SUBROUTINE reduce_sum_r3(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_r3 + + + SUBROUTINE reduce_sum_r4(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL reduce_sum_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_sum_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_sum_r4 + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Definition des reduce_min --> 4D !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Les entiers + + SUBROUTINE reduce_min_i(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN) :: VarIn + INTEGER,INTENT(OUT) :: VarOut + + INTEGER :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_i + + + SUBROUTINE reduce_min_i1(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_i1 + + + SUBROUTINE reduce_min_i2(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_i2 + + + SUBROUTINE reduce_min_i3(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_i3 + + + SUBROUTINE reduce_min_i4(VarIn, VarOut) + IMPLICIT NONE + + INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_i4 + + +! Les reels + + SUBROUTINE reduce_min_r(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN) :: VarIn + REAL,INTENT(OUT) :: VarOut + + REAL :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_r + + + SUBROUTINE reduce_min_r1(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_r1 + + + SUBROUTINE reduce_min_r2(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_r2 + + + SUBROUTINE reduce_min_r3(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_r3 + + + SUBROUTINE reduce_min_r4(VarIn, VarOut) + IMPLICIT NONE + + REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn + REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut + + REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp + + CALL reduce_min_omp(VarIn,Var_tmp) +!$OMP MASTER + CALL reduce_min_mpi(Var_tmp,VarOut) +!$OMP END MASTER + + END SUBROUTINE reduce_min_r4 + + + +END MODULE mod_phys_lmdz_transfert_para + Index: LMDZ6/trunk/libf/phy_common/physics_distribution_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/physics_distribution_mod.F90 (revision 5267) +++ (revision ) @@ -1,88 +1,0 @@ -! -!$Id$ -! -MODULE physics_distribution_mod - - -CONTAINS - - SUBROUTINE init_physics_distribution(grid_type, nvertex, & - nbp, nbp_lon, nbp_lat, nbp_lev, & - communicator) - USE mod_phys_lmdz_para, ONLY: init_phys_lmdz_para, klon_omp - USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz - USE dimphy, ONLY : Init_dimphy - USE infotrac_phy, ONLY : type_trac - USE lmdz_reprobus_wrappers, ONLY : Init_chem_rep_phys - USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS - - IMPLICIT NONE - INTEGER,INTENT(IN) :: grid_type - INTEGER,INTENT(IN) :: nvertex - INTEGER,INTENT(IN) :: nbp - INTEGER,INTENT(IN) :: nbp_lon - INTEGER,INTENT(IN) :: nbp_lat - INTEGER,INTENT(IN) :: nbp_lev - INTEGER,INTENT(IN) :: communicator - - - CALL init_grid_phy_lmdz(grid_type,nvertex, nbp_lon,nbp_lat,nbp_lev) - CALL init_phys_lmdz_para(nbp,nbp_lon, nbp_lat,nbp_lev, grid_type,nvertex, communicator) -!$OMP PARALLEL - CALL init_dimphy(klon_omp,nbp_lev) - -IF (CPPKEY_INCA) THEN - CALL Init_inca_dim(klon_omp,nbp_lev) -END IF - -IF (CPPKEY_REPROBUS) THEN -! Initialization of Reprobus - IF (type_trac == 'repr') CALL Init_chem_rep_phys(klon_omp,nbp_lev) -END IF - -!$OMP END PARALLEL - - END SUBROUTINE init_physics_distribution - -!SUBROUTINE Init_Phys_lmdz(iim,jjp1,llm,nb_proc,distrib) -! USE mod_phys_lmdz_para, ONLY: Init_phys_lmdz_para!, klon_omp -! USE mod_grid_phy_lmdz, ONLY: Init_grid_phy_lmdz!, nbp_lev -! USE dimphy, ONLY : Init_dimphy -! USE infotrac_phy, ONLY : type_trac -!#ifdef REPROBUS -! USE lmdz_reprobus_wrappers, ONLY : Init_chem_rep_phys -!#endif - -! IMPLICIT NONE - -! INTEGER,INTENT(in) :: iim -! INTEGER,INTENT(in) :: jjp1 -! INTEGER,INTENT(in) :: llm -! INTEGER,INTENT(in) :: nb_proc -! INTEGER,INTENT(in) :: distrib(0:nb_proc-1) - - -! CALL Init_grid_phy_lmdz(iim,jjp1,llm) -! CALL Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib) -!!$OMP PARALLEL -! CALL Init_dimphy(klon_omp,nbp_lev) -! -!#ifdef REPROBUS -!! Initialization of Reprobus -! IF (type_trac == 'repr') CALL Init_chem_rep_phys(klon_omp,nbp_lev) -! END IF -!#endif -! -!!$OMP END PARALLEL - -!END SUBROUTINE Init_Phys_lmdz - - - - - - - - -END MODULE physics_distribution_mod - Index: LMDZ6/trunk/libf/phy_common/physics_distribution_mod.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/physics_distribution_mod.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/physics_distribution_mod.f90 (revision 5268) @@ -0,0 +1,88 @@ +! +!$Id$ +! +MODULE physics_distribution_mod + + +CONTAINS + + SUBROUTINE init_physics_distribution(grid_type, nvertex, & + nbp, nbp_lon, nbp_lat, nbp_lev, & + communicator) + USE mod_phys_lmdz_para, ONLY: init_phys_lmdz_para, klon_omp + USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz + USE dimphy, ONLY : Init_dimphy + USE infotrac_phy, ONLY : type_trac + USE lmdz_reprobus_wrappers, ONLY : Init_chem_rep_phys + USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS + + IMPLICIT NONE + INTEGER,INTENT(IN) :: grid_type + INTEGER,INTENT(IN) :: nvertex + INTEGER,INTENT(IN) :: nbp + INTEGER,INTENT(IN) :: nbp_lon + INTEGER,INTENT(IN) :: nbp_lat + INTEGER,INTENT(IN) :: nbp_lev + INTEGER,INTENT(IN) :: communicator + + + CALL init_grid_phy_lmdz(grid_type,nvertex, nbp_lon,nbp_lat,nbp_lev) + CALL init_phys_lmdz_para(nbp,nbp_lon, nbp_lat,nbp_lev, grid_type,nvertex, communicator) +!$OMP PARALLEL + CALL init_dimphy(klon_omp,nbp_lev) + +IF (CPPKEY_INCA) THEN + CALL Init_inca_dim(klon_omp,nbp_lev) +END IF + +IF (CPPKEY_REPROBUS) THEN +! Initialization of Reprobus + IF (type_trac == 'repr') CALL Init_chem_rep_phys(klon_omp,nbp_lev) +END IF + +!$OMP END PARALLEL + + END SUBROUTINE init_physics_distribution + +!SUBROUTINE Init_Phys_lmdz(iim,jjp1,llm,nb_proc,distrib) +! USE mod_phys_lmdz_para, ONLY: Init_phys_lmdz_para!, klon_omp +! USE mod_grid_phy_lmdz, ONLY: Init_grid_phy_lmdz!, nbp_lev +! USE dimphy, ONLY : Init_dimphy +! USE infotrac_phy, ONLY : type_trac +!#ifdef REPROBUS +! USE lmdz_reprobus_wrappers, ONLY : Init_chem_rep_phys +!#endif + +! IMPLICIT NONE + +! INTEGER,INTENT(in) :: iim +! INTEGER,INTENT(in) :: jjp1 +! INTEGER,INTENT(in) :: llm +! INTEGER,INTENT(in) :: nb_proc +! INTEGER,INTENT(in) :: distrib(0:nb_proc-1) + + +! CALL Init_grid_phy_lmdz(iim,jjp1,llm) +! CALL Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib) +!!$OMP PARALLEL +! CALL Init_dimphy(klon_omp,nbp_lev) +! +!#ifdef REPROBUS +!! Initialization of Reprobus +! IF (type_trac == 'repr') CALL Init_chem_rep_phys(klon_omp,nbp_lev) +! END IF +!#endif +! +!!$OMP END PARALLEL + +!END SUBROUTINE Init_Phys_lmdz + + + + + + + + +END MODULE physics_distribution_mod + Index: LMDZ6/trunk/libf/phy_common/print_control_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/print_control_mod.F90 (revision 5267) +++ (revision ) @@ -1,62 +1,0 @@ -! $Id: $ -MODULE print_control_mod - - INTEGER,SAVE :: lunout ! default output file identifier (6==screen) - INTEGER,SAVE :: prt_level ! debug output level - LOGICAL,SAVE :: debug ! flag to specify if in "debug mode" - LOGICAL,SAVE :: alert_first_call = .TRUE. ! for printing alerts on first call to routine only - LOGICAL,SAVE :: call_alert ! (combination of is_master and alert_first_call for easier use -!$OMP THREADPRIVATE(lunout,prt_level,debug, alert_first_call, call_alert) - - ! NB: Module variable Initializations done by set_print_control - ! routine from init_print_control_mod to avoid circular - ! module dependencies - -CONTAINS - - SUBROUTINE set_print_control(lunout_,prt_level_,debug_) - IMPLICIT NONE - INTEGER, INTENT(IN) :: lunout_ - INTEGER, INTENT(IN) :: prt_level_ - LOGICAL, INTENT(IN) :: debug_ - - lunout = lunout_ - prt_level = prt_level_ - debug = debug_ - - END SUBROUTINE set_print_control - - SUBROUTINE prt_alerte(message, modname, niv_alerte) - ! Function to print different values of alarms when first encountered - ! Meant for informative purposee - IMPLICIT NONE - ! Arguments: - ! message: message to print out - ! modname: module/routine name - ! niv_alerte: alert level (0/1/2) - CHARACTER(LEN=*), INTENT(IN) :: modname - CHARACTER(LEN=*) :: message - INTEGER :: niv_alerte - ! local variables - CHARACTER(LEN=7), DIMENSION(0:2) :: alarm_color = (/ 'VERTE ','ORANGE ','ROUGE ' /) - CHARACTER(LEN=7) :: alarm_couleur - INTEGER :: alarm_file=15 ! in case we want/need to print out the special alarms in a separate file - - IF ( alert_first_call) then - IF ( alarm_file .ne. lunout ) THEN - OPEN(unit = alarm_file, file = "ALERTES.txt") - ENDIF - ENDIF - - alarm_couleur = alarm_color(niv_alerte) - IF (niv_alerte < 0 .OR. niv_alerte > 3) then - message = 'NIVEAU ALERTE INVALIDE '//message - alarm_couleur='NOIRE ' - ENDIF - - WRITE(alarm_file, *)' ALERTE ',alarm_couleur, trim(modname), trim(message) - - END SUBROUTINE prt_alerte - - -END MODULE print_control_mod Index: LMDZ6/trunk/libf/phy_common/print_control_mod.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/print_control_mod.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/print_control_mod.f90 (revision 5268) @@ -0,0 +1,62 @@ +! $Id: $ +MODULE print_control_mod + + INTEGER,SAVE :: lunout ! default output file identifier (6==screen) + INTEGER,SAVE :: prt_level ! debug output level + LOGICAL,SAVE :: debug ! flag to specify if in "debug mode" + LOGICAL,SAVE :: alert_first_call = .TRUE. ! for printing alerts on first call to routine only + LOGICAL,SAVE :: call_alert ! (combination of is_master and alert_first_call for easier use +!$OMP THREADPRIVATE(lunout,prt_level,debug, alert_first_call, call_alert) + + ! NB: Module variable Initializations done by set_print_control + ! routine from init_print_control_mod to avoid circular + ! module dependencies + +CONTAINS + + SUBROUTINE set_print_control(lunout_,prt_level_,debug_) + IMPLICIT NONE + INTEGER, INTENT(IN) :: lunout_ + INTEGER, INTENT(IN) :: prt_level_ + LOGICAL, INTENT(IN) :: debug_ + + lunout = lunout_ + prt_level = prt_level_ + debug = debug_ + + END SUBROUTINE set_print_control + + SUBROUTINE prt_alerte(message, modname, niv_alerte) + ! Function to print different values of alarms when first encountered + ! Meant for informative purposee + IMPLICIT NONE + ! Arguments: + ! message: message to print out + ! modname: module/routine name + ! niv_alerte: alert level (0/1/2) + CHARACTER(LEN=*), INTENT(IN) :: modname + CHARACTER(LEN=*) :: message + INTEGER :: niv_alerte + ! local variables + CHARACTER(LEN=7), DIMENSION(0:2) :: alarm_color = (/ 'VERTE ','ORANGE ','ROUGE ' /) + CHARACTER(LEN=7) :: alarm_couleur + INTEGER :: alarm_file=15 ! in case we want/need to print out the special alarms in a separate file + + IF ( alert_first_call) then + IF ( alarm_file .ne. lunout ) THEN + OPEN(unit = alarm_file, file = "ALERTES.txt") + ENDIF + ENDIF + + alarm_couleur = alarm_color(niv_alerte) + IF (niv_alerte < 0 .OR. niv_alerte > 3) then + message = 'NIVEAU ALERTE INVALIDE '//message + alarm_couleur='NOIRE ' + ENDIF + + WRITE(alarm_file, *)' ALERTE ',alarm_couleur, trim(modname), trim(message) + + END SUBROUTINE prt_alerte + + +END MODULE print_control_mod Index: LMDZ6/trunk/libf/phy_common/regular_lonlat_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/regular_lonlat_mod.F90 (revision 5267) +++ (revision ) @@ -1,55 +1,0 @@ -MODULE regular_lonlat_mod - - ! Store information on the global physics grid - ! for a regular (longitude-latitude) grid - - INTEGER, PARAMETER :: north_east=1 ! boundaries of regular lontlat - INTEGER, PARAMETER :: north_west=2 ! boundaries of regular lontlat - INTEGER, PARAMETER :: south_west=3 ! boundaries of regular lontlat - INTEGER, PARAMETER :: south_east=4 ! boundaries of regular lontlat - INTEGER, PARAMETER :: east=2 ! boundaries of regular lontlat - INTEGER, PARAMETER :: west=1 ! boundaries of regular lontlat - INTEGER, PARAMETER :: north=1 ! boundaries of regular lontlat - INTEGER, PARAMETER :: south=2 ! boundaries of regular lontlat - -! Global definition, shared by all threads -! Do not set threadprivate directives - - REAL,SAVE,ALLOCATABLE :: lon_reg(:) ! value of longitude cell (rad) - - REAL,SAVE,ALLOCATABLE :: lat_reg(:) ! value of longitude cell (rad) - - REAL,SAVE,ALLOCATABLE :: boundslon_reg(:,:) ! value of boundaries cell (1=>west, 2=>east)(rad) - - REAL,SAVE,ALLOCATABLE :: boundslat_reg(:,:) ! value of longitude cell (1=>north, 2=>south)(rad) - - -CONTAINS - - SUBROUTINE init_regular_lonlat(nbp_lon, nbp_lat, lon_reg_, lat_reg_, boundslon_reg_, boundslat_reg_) - IMPLICIT NONE - INTEGER,INTENT(IN) :: nbp_lon - INTEGER,INTENT(IN) :: nbp_lat - REAL, INTENT(IN) :: lon_reg_(nbp_lon) - REAL, INTENT(IN) :: lat_reg_(nbp_lat) - REAL, INTENT(IN) :: boundslon_reg_(nbp_lon,2) - REAL, INTENT(IN) :: boundslat_reg_(nbp_lat,2) - - - ALLOCATE(lon_reg(nbp_lon)) - lon_reg(:)=lon_reg_(:) - - ALLOCATE(lat_reg(nbp_lat)) - lat_reg(:)=lat_reg_(:) - - ALLOCATE(boundslon_reg(nbp_lon,2)) - boundslon_reg(:,:)=boundslon_reg_(:,:) - - ALLOCATE(boundslat_reg(nbp_lat,2)) - boundslat_reg(:,:)=boundslat_reg_(:,:) - - - END SUBROUTINE init_regular_lonlat - -END MODULE regular_lonlat_mod - Index: LMDZ6/trunk/libf/phy_common/regular_lonlat_mod.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/regular_lonlat_mod.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/regular_lonlat_mod.f90 (revision 5268) @@ -0,0 +1,55 @@ +MODULE regular_lonlat_mod + + ! Store information on the global physics grid + ! for a regular (longitude-latitude) grid + + INTEGER, PARAMETER :: north_east=1 ! boundaries of regular lontlat + INTEGER, PARAMETER :: north_west=2 ! boundaries of regular lontlat + INTEGER, PARAMETER :: south_west=3 ! boundaries of regular lontlat + INTEGER, PARAMETER :: south_east=4 ! boundaries of regular lontlat + INTEGER, PARAMETER :: east=2 ! boundaries of regular lontlat + INTEGER, PARAMETER :: west=1 ! boundaries of regular lontlat + INTEGER, PARAMETER :: north=1 ! boundaries of regular lontlat + INTEGER, PARAMETER :: south=2 ! boundaries of regular lontlat + +! Global definition, shared by all threads +! Do not set threadprivate directives + + REAL,SAVE,ALLOCATABLE :: lon_reg(:) ! value of longitude cell (rad) + + REAL,SAVE,ALLOCATABLE :: lat_reg(:) ! value of longitude cell (rad) + + REAL,SAVE,ALLOCATABLE :: boundslon_reg(:,:) ! value of boundaries cell (1=>west, 2=>east)(rad) + + REAL,SAVE,ALLOCATABLE :: boundslat_reg(:,:) ! value of longitude cell (1=>north, 2=>south)(rad) + + +CONTAINS + + SUBROUTINE init_regular_lonlat(nbp_lon, nbp_lat, lon_reg_, lat_reg_, boundslon_reg_, boundslat_reg_) + IMPLICIT NONE + INTEGER,INTENT(IN) :: nbp_lon + INTEGER,INTENT(IN) :: nbp_lat + REAL, INTENT(IN) :: lon_reg_(nbp_lon) + REAL, INTENT(IN) :: lat_reg_(nbp_lat) + REAL, INTENT(IN) :: boundslon_reg_(nbp_lon,2) + REAL, INTENT(IN) :: boundslat_reg_(nbp_lat,2) + + + ALLOCATE(lon_reg(nbp_lon)) + lon_reg(:)=lon_reg_(:) + + ALLOCATE(lat_reg(nbp_lat)) + lat_reg(:)=lat_reg_(:) + + ALLOCATE(boundslon_reg(nbp_lon,2)) + boundslon_reg(:,:)=boundslon_reg_(:,:) + + ALLOCATE(boundslat_reg(nbp_lat,2)) + boundslat_reg(:,:)=boundslat_reg_(:,:) + + + END SUBROUTINE init_regular_lonlat + +END MODULE regular_lonlat_mod + Index: LMDZ6/trunk/libf/phy_common/vertical_layers_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/vertical_layers_mod.F90 (revision 5267) +++ (revision ) @@ -1,61 +1,0 @@ -! $Id: $ - -MODULE vertical_layers_mod - - REAL,SAVE :: preff ! reference surface pressure (Pa) - REAL,SAVE :: scaleheight ! atmospheric reference scale height (km) - REAL,SAVE,ALLOCATABLE :: ap(:) ! hybrid (pressure contribution) coordinate - ! at layer interfaces (Pa) - REAL,SAVE,ALLOCATABLE :: bp(:) ! hybrid (sigma contribution) coordinate - ! at layer interfaces (Pa) - REAL,SAVE,ALLOCATABLE :: aps(:) ! hybrid (pressure contribution) coordinate - ! at mid-layer (Pa) - REAL,SAVE,ALLOCATABLE :: bps(:) ! hybrid (sigma contribution) coordinate - ! at mid-layer - REAL,SAVE,ALLOCATABLE :: presnivs(:) ! reference pressure at mid-layer (Pa), - ! based on preff, ap and bp - REAL,SAVE,ALLOCATABLE :: presinter(:) ! reference pressure at interface (Pa), - ! based on preff, ap and bp - REAL,SAVE,ALLOCATABLE :: pseudoalt(:) ! pseudo-altitude of model layers (km), - ! based on preff and scaleheight - -!$OMP THREADPRIVATE(preff,scaleheight,ap,bp,aps,bps,presnivs,presinter,pseudoalt) - - -CONTAINS - - SUBROUTINE init_vertical_layers(nlayer,preff_,scaleheight_,ap_,bp_,& - aps_,bps_,presnivs_, presinter_, pseudoalt_) - IMPLICIT NONE - INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers - REAL,INTENT(IN) :: preff_ ! reference surface pressure (Pa) - REAL,INTENT(IN) :: scaleheight_ ! atmospheric scale height (km) - REAL,INTENT(IN) :: ap_(nlayer+1) ! hybrid coordinate at interfaces - REAL,INTENT(IN) :: bp_(nlayer+1) ! hybrid coordinate at interfaces - REAL,INTENT(IN) :: aps_(nlayer) ! hybrid coordinate at mid-layer - REAL,INTENT(IN) :: bps_(nlayer) ! hybrid coordinate at mid-layer - REAL,INTENT(IN) :: presnivs_(nlayer) ! Appproximative pressure of atm. layers (Pa) - REAL,INTENT(IN) :: presinter_(nlayer+1) ! Appproximative pressure of atm. layers (Pa) - REAL,INTENT(IN) :: pseudoalt_(nlayer) ! pseudo-altitude of atm. layers (km) - - ALLOCATE(ap(nlayer+1)) - ALLOCATE(bp(nlayer+1)) - ALLOCATE(aps(nlayer)) - ALLOCATE(bps(nlayer)) - ALLOCATE(presnivs(nlayer)) - ALLOCATE(presinter(nlayer+1)) - ALLOCATE(pseudoalt(nlayer)) - - preff = preff_ - scaleheight=scaleheight_ - ap(:) = ap_(:) - bp(:) = bp_(:) - aps(:) = aps_(:) - bps(:) = bps_(:) - presnivs(:) = presnivs_(:) - presinter(:) = presinter_(:) - pseudoalt(:) = pseudoalt_(:) - - END SUBROUTINE init_vertical_layers - -END MODULE vertical_layers_mod Index: LMDZ6/trunk/libf/phy_common/vertical_layers_mod.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/vertical_layers_mod.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/vertical_layers_mod.f90 (revision 5268) @@ -0,0 +1,61 @@ +! $Id: $ + +MODULE vertical_layers_mod + + REAL,SAVE :: preff ! reference surface pressure (Pa) + REAL,SAVE :: scaleheight ! atmospheric reference scale height (km) + REAL,SAVE,ALLOCATABLE :: ap(:) ! hybrid (pressure contribution) coordinate + ! at layer interfaces (Pa) + REAL,SAVE,ALLOCATABLE :: bp(:) ! hybrid (sigma contribution) coordinate + ! at layer interfaces (Pa) + REAL,SAVE,ALLOCATABLE :: aps(:) ! hybrid (pressure contribution) coordinate + ! at mid-layer (Pa) + REAL,SAVE,ALLOCATABLE :: bps(:) ! hybrid (sigma contribution) coordinate + ! at mid-layer + REAL,SAVE,ALLOCATABLE :: presnivs(:) ! reference pressure at mid-layer (Pa), + ! based on preff, ap and bp + REAL,SAVE,ALLOCATABLE :: presinter(:) ! reference pressure at interface (Pa), + ! based on preff, ap and bp + REAL,SAVE,ALLOCATABLE :: pseudoalt(:) ! pseudo-altitude of model layers (km), + ! based on preff and scaleheight + +!$OMP THREADPRIVATE(preff,scaleheight,ap,bp,aps,bps,presnivs,presinter,pseudoalt) + + +CONTAINS + + SUBROUTINE init_vertical_layers(nlayer,preff_,scaleheight_,ap_,bp_,& + aps_,bps_,presnivs_, presinter_, pseudoalt_) + IMPLICIT NONE + INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers + REAL,INTENT(IN) :: preff_ ! reference surface pressure (Pa) + REAL,INTENT(IN) :: scaleheight_ ! atmospheric scale height (km) + REAL,INTENT(IN) :: ap_(nlayer+1) ! hybrid coordinate at interfaces + REAL,INTENT(IN) :: bp_(nlayer+1) ! hybrid coordinate at interfaces + REAL,INTENT(IN) :: aps_(nlayer) ! hybrid coordinate at mid-layer + REAL,INTENT(IN) :: bps_(nlayer) ! hybrid coordinate at mid-layer + REAL,INTENT(IN) :: presnivs_(nlayer) ! Appproximative pressure of atm. layers (Pa) + REAL,INTENT(IN) :: presinter_(nlayer+1) ! Appproximative pressure of atm. layers (Pa) + REAL,INTENT(IN) :: pseudoalt_(nlayer) ! pseudo-altitude of atm. layers (km) + + ALLOCATE(ap(nlayer+1)) + ALLOCATE(bp(nlayer+1)) + ALLOCATE(aps(nlayer)) + ALLOCATE(bps(nlayer)) + ALLOCATE(presnivs(nlayer)) + ALLOCATE(presinter(nlayer+1)) + ALLOCATE(pseudoalt(nlayer)) + + preff = preff_ + scaleheight=scaleheight_ + ap(:) = ap_(:) + bp(:) = bp_(:) + aps(:) = aps_(:) + bps(:) = bps_(:) + presnivs(:) = presnivs_(:) + presinter(:) = presinter_(:) + pseudoalt(:) = pseudoalt_(:) + + END SUBROUTINE init_vertical_layers + +END MODULE vertical_layers_mod Index: LMDZ6/trunk/libf/phy_common/write_field_phy.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/write_field_phy.F90 (revision 5267) +++ (revision ) @@ -1,37 +1,0 @@ -! -! $Id$ -! -MODULE write_field_phy - - ! Dump a field on the global (nbp_lon by nbp_lat) physics grid - - CONTAINS - - SUBROUTINE WriteField_phy(name,Field,ll) - USE mod_phys_lmdz_para, ONLY: klon_omp, is_mpi_root, & - Gather - USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, & - Grid1Dto2D_glo - USE Write_Field, ONLY: WriteField - - IMPLICIT NONE - - CHARACTER(len=*),INTENT(IN) :: name - INTEGER,INTENT(IN) :: ll - REAL,INTENT(IN) :: Field(klon_omp,ll) - - real, dimension(klon_glo,ll):: New_Field - real, dimension(nbp_lon,nbp_lat,ll):: Field_2d - - CALL Gather(Field,New_Field) -!$OMP MASTER - IF (is_mpi_root) THEN - CALL Grid1Dto2D_glo(New_Field,Field_2D) - CALL WriteField(name,Field_2d) - ENDIF -!$OMP END MASTER - - - END SUBROUTINE WriteField_phy - - END MODULE write_field_phy Index: LMDZ6/trunk/libf/phy_common/write_field_phy.f90 =================================================================== --- LMDZ6/trunk/libf/phy_common/write_field_phy.f90 (revision 5268) +++ LMDZ6/trunk/libf/phy_common/write_field_phy.f90 (revision 5268) @@ -0,0 +1,37 @@ +! +! $Id$ +! +MODULE write_field_phy + + ! Dump a field on the global (nbp_lon by nbp_lat) physics grid + + CONTAINS + + SUBROUTINE WriteField_phy(name,Field,ll) + USE mod_phys_lmdz_para, ONLY: klon_omp, is_mpi_root, & + Gather + USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, & + Grid1Dto2D_glo + USE Write_Field, ONLY: WriteField + + IMPLICIT NONE + + CHARACTER(len=*),INTENT(IN) :: name + INTEGER,INTENT(IN) :: ll + REAL,INTENT(IN) :: Field(klon_omp,ll) + + real, dimension(klon_glo,ll):: New_Field + real, dimension(nbp_lon,nbp_lat,ll):: Field_2d + + CALL Gather(Field,New_Field) +!$OMP MASTER + IF (is_mpi_root) THEN + CALL Grid1Dto2D_glo(New_Field,Field_2D) + CALL WriteField(name,Field_2d) + ENDIF +!$OMP END MASTER + + + END SUBROUTINE WriteField_phy + + END MODULE write_field_phy