Skip to content
Snippets Groups Projects
Commit 0e1dc180 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 02/01/2023: import GET_HALO_DDC from ZSOLVER/

parent 8bc3e143
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 347 additions and 1 deletion
src/MNH/get_halo.f90
+ 347
− 1
View file @ 0e1dc180
!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
......@@ -60,6 +60,7 @@ INTERFACE
!
END SUBROUTINE GET_HALO_START_D
END INTERFACE
INTERFACE
SUBROUTINE GET_HALO_STOP_D(PSRC,KNB_REQ,KREQ,HDIR)
IMPLICIT NONE
......@@ -69,6 +70,17 @@ INTERFACE
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
END SUBROUTINE GET_HALO_STOP_D
END INTERFACE
INTERFACE
SUBROUTINE GET_HALO_DDC(PSRC, HDIR, HNAME)
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
!
END SUBROUTINE GET_HALO_DDC
END INTERFACE
#endif
!
INTERFACE
......@@ -166,6 +178,9 @@ MODULE MODD_HALO_D
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTHC_IN, ZSOUTHC_IN, ZWESTC_IN, ZEASTC_IN
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTHC_OUT, ZSOUTHC_OUT, ZWESTC_OUT, ZEASTC_OUT
LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
......@@ -202,6 +217,20 @@ CONTAINS
ALLOCATE ( ZWEST_OUT ( 1:IIB-1 , IJB:IJE , IKU ) )
ALLOCATE ( ZEAST_OUT ( IIE+1:IIU , IJB:IJE , IKU ) )
!$acc enter data create (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT)
!
! Init HALO with Corner
!
ALLOCATE ( ZSOUTHC_IN ( 1:IIU , IJB:IJB+IHALO_1 , IKU ) )
ALLOCATE ( ZNORTHC_IN ( 1:IIU , IJE-IHALO_1:IJE , IKU ) )
ALLOCATE ( ZWESTC_IN ( IIB:IIB+IHALO_1 , IJB:IJE , IKU ) )
ALLOCATE ( ZEASTC_IN ( IIE-IHALO_1:IIE , IJB:IJE , IKU ) )
!$acc enter data create (ZNORTHC_IN, ZSOUTHC_IN, ZWESTC_IN, ZEASTC_IN)
!
ALLOCATE ( ZSOUTHC_OUT ( 1:IIU , 1:IJB-1 , IKU ) )
ALLOCATE ( ZNORTHC_OUT ( 1:IIU , IJE+1:IJU , IKU ) )
ALLOCATE ( ZWESTC_OUT ( 1:IIB-1 , IJB:IJE , IKU ) )
ALLOCATE ( ZEASTC_OUT ( IIE+1:IIU , IJB:IJE , IKU ) )
!$acc enter data create (ZNORTHC_OUT, ZSOUTHC_OUT, ZWESTC_OUT, ZEASTC_OUT)
IF (.NOT. GWEST ) THEN
NP_WEST = ( IP-1 -1 ) + 1
......@@ -909,6 +938,323 @@ END IF
!$acc end data
END SUBROUTINE GET_HALO_DD
!-------------------------------------------------------------------------------
! ########################################
SUBROUTINE GET_HALO_DDC(PSRC, HDIR, HNAME)
! ########################################
#define MNH_GPUDIRECT
!
USE MODD_HALO_D
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_PARAMETERS, ONLY : JPHEXT
!
USE MODD_IO, ONLY : GSMONOPROC
USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
!
USE MODD_CONF, ONLY : NHALO
USE MODE_DEVICE
USE MODE_MPPDB
USE MODD_VAR_ll, ONLY : IP,NPROC,NP1,NP2
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
USE MODD_MPIF, ONLY : MPI_STATUSES_IGNORE
USE MODD_PRECISION, ONLY : MNHREAL_MPI
!
USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
USE MODE_MNH_ZWORK, ONLY : IIB,IJB ,IIE,IJE
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
!
character(len=:), allocatable :: yname
TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
INTEGER :: IERROR ! error return code
INTEGER,PARAMETER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
LOGICAL :: LX , LY
INTEGER :: INB_REQEW , IREQEW(4)
INTEGER :: INB_REQNS , IREQNS(4)
INTEGER :: IERR
CALL MPPDB_CHECK(PSRC,"GET_HALO_DDC big:PSRC")
if ( NPROC == 1 ) then
!CALL MPPDB_CHECK(PSRC,'UPDATE_HALO_ll::'//TRIM(HNAME))
CALL MPPDB_CHECK(PSRC,"GET_HALO_DDC end:PSRC")
RETURN
endif
CALL INIT_HALO_D()
!$acc data present ( PSRC )
NULLIFY( TZ_PSRC_ll)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
LX = .FALSE.
LY = .FALSE.
IF (.NOT. PRESENT(HDIR) ) THEN
LX = .TRUE.
LY = .TRUE.
ELSE
!
! Problem of reproductibility in ppm_s0_x/y if only S0_X or S0_Y
! so add S0_X + S0_Y for ppm_s0*
!
!!$LX = ( HDIR == "01_X" .OR. HDIR == "S0_X" )
!!$LY = ( HDIR == "01_Y" .OR. HDIR == "S0_Y" )
LX = ( HDIR == "01_X" .OR. HDIR == "S0_X" .OR. HDIR == "S0_Y" )
LY = ( HDIR == "01_Y" .OR. HDIR == "S0_Y" .OR. HDIR == "S0_X" )
END IF
!!$LX = .TRUE.
!!$LY = .TRUE.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Post first the recieve of ZxxxxC_OUT buffer via MPI(Gpu_direct)
!
!-------------------------------------------------------------------------------!
! IRecv E/W !
!-------------------------------------------------------------------------------!
INB_REQEW = 0
IF (LX) THEN
IF (.NOT. GWEST) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZWESTC_OUT)
#endif
INB_REQEW = INB_REQEW + 1
CALL MPI_IRECV(ZWESTC_OUT,SIZE(ZWESTC_OUT),MNHREAL_MPI,NP_WEST-1,1000+IS_EAST,&
NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
END IF
IF (.NOT.GEAST) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZEASTC_OUT)
#endif
INB_REQEW = INB_REQEW + 1
CALL MPI_IRECV(ZEASTC_OUT,SIZE(ZEASTC_OUT),MNHREAL_MPI,NP_EAST-1,1000+IS_WEST,&
NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
ENDIF
END IF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!Copy the halo E/W on the device PSRC to ZxxxxC_IN
IF (LX) THEN
IF (.NOT. GWEST) THEN
!$acc kernels async(IS_WEST)
ZWESTC_IN ( IIB:IIB+IHALO_1 , IJB:IJE , : ) = PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : )
!$acc end kernels
END IF
IF (.NOT.GEAST) THEN
!$acc kernels async(IS_EAST)
ZEASTC_IN ( IIE-IHALO_1:IIE , IJB:IJE , : ) = PSRC( IIE-IHALO_1:IIE , IJB:IJE , : )
!$acc end kernels
ENDIF
!$acc wait
END IF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Send E/W ZxxxxC_IN buffer via MPI(Gpu_direct) or copy to host
!
IF (LX) THEN
IF (.NOT. GWEST) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZWESTC_IN)
#else
!$acc update host(ZWESTC_IN)
#endif
INB_REQEW = INB_REQEW + 1
CALL MPI_ISEND(ZWESTC_IN,SIZE(ZWESTC_IN) ,MNHREAL_MPI,NP_WEST-1,1000+IS_WEST,&
NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
END IF
IF (.NOT.GEAST) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZEASTC_IN)
#else
!$acc update host(ZEASTC_IN)
#endif
INB_REQEW = INB_REQEW + 1
CALL MPI_ISEND(ZEASTC_IN,SIZE(ZEASTC_IN) ,MNHREAL_MPI,NP_EAST-1,1000+IS_EAST,&
NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
ENDIF
END IF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF ( INB_REQEW > 0 ) THEN
CALL MPI_WAITALL(INB_REQEW,IREQEW,MPI_STATUSES_IGNORE,IERR)
END IF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Update halo E/W from buffer to PSRC
IF (LX) THEN
IF (.NOT.GWEST) THEN
#ifndef MNH_GPUDIRECT
!$acc update device(ZWESTC_OUT) async(IS_WEST)
#endif
!$acc kernels async(IS_WEST)
PSRC( 1:IIB-1 , IJB:IJE , : ) = ZWESTC_OUT( 1:IIB-1 , IJB:IJE , : )
!$acc end kernels
ENDIF
IF (.NOT.GEAST) THEN
#ifndef MNH_GPUDIRECT
!$acc update device(ZEASTC_OUT) async(IS_EAST)
#endif
!$acc kernels async(IS_EAST)
PSRC( IIE+1:IIU , IJB:IJE , : ) = ZEASTC_OUT( IIE+1:IIU , IJB:IJE , : )
!$acc end kernels
ENDIF
!$acc wait
END IF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Post first the recieve of N/S ZxxxxC_OUT buffer via MPI(Gpu_direct)
!
!-------------------------------------------------------------------------------!
! IRecv N/S !
!-------------------------------------------------------------------------------!
INB_REQNS = 0
IF (LY) THEN
IF (.NOT.GSOUTH) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZSOUTHC_OUT)
#endif
INB_REQNS = INB_REQNS + 1
CALL MPI_IRECV(ZSOUTHC_OUT,SIZE(ZSOUTHC_OUT),MNHREAL_MPI,NP_SOUTH-1,1000+IS_NORTH,&
NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
ENDIF
IF (.NOT.GNORTH) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZNORTHC_OUT)
#endif
INB_REQNS = INB_REQNS + 1
CALL MPI_IRECV(ZNORTHC_OUT,SIZE(ZNORTHC_OUT),MNHREAL_MPI,NP_NORTH-1,1000+IS_SOUTH,&
NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
ENDIF
END IF
!
!Copy the halo N/S on the device PSRC to ZxxxxC_IN
!
IF (LY) THEN
IF (.NOT.GSOUTH) THEN
!$acc kernels async(IS_SOUTH)
ZSOUTHC_IN ( 1:IIU , IJB:IJB+IHALO_1 , : ) = PSRC( 1:IIU , IJB:IJB+IHALO_1 , : )
!$acc end kernels
ENDIF
IF (.NOT.GNORTH) THEN
!$acc kernels async(IS_NORTH)
ZNORTHC_IN ( 1:IIU , IJE-IHALO_1:IJE , : ) = PSRC( 1:IIU , IJE-IHALO_1:IJE , : )
!$acc end kernels
ENDIF
!$acc wait
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Send N/S ZxxxxC_IN buffer via MPI(Gpu_direct) or copy to host
!
IF (LY) THEN
IF (.NOT.GSOUTH) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZSOUTHC_IN)
#else
!$acc update host(ZSOUTHC_IN)
#endif
INB_REQNS = INB_REQNS + 1
CALL MPI_ISEND(ZSOUTHC_IN,SIZE(ZSOUTHC_IN) ,MNHREAL_MPI,NP_SOUTH-1,1000+IS_SOUTH,&
NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
ENDIF
IF (.NOT.GNORTH) THEN
#ifdef MNH_GPUDIRECT
!$acc host_data use_device(ZNORTHC_IN)
#else
!$acc update host(ZNORTHC_IN)
#endif
INB_REQNS = INB_REQNS + 1
CALL MPI_ISEND(ZNORTHC_IN,SIZE(ZNORTHC_IN) ,MNHREAL_MPI,NP_NORTH-1,1000+IS_NORTH,&
NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
#ifdef MNH_GPUDIRECT
!$acc end host_data
#endif
ENDIF
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF ( INB_REQNS > 0 ) THEN
CALL MPI_WAITALL(INB_REQNS,IREQNS,MPI_STATUSES_IGNORE,IERR)
END IF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Update halo N/S
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Update halo N/S/W from buffer to PSRC
IF (LY) THEN
IF (.NOT.GSOUTH) THEN
#ifndef MNH_GPUDIRECT
!$acc update device(ZSOUTHC_OUT) async(IS_SOUTH)
#endif
!$acc kernels async(IS_SOUTH)
PSRC( 1:IIU , 1:IJB-1 , : ) = ZSOUTHC_OUT( 1:IIU , 1:IJB-1 , : )
!$acc end kernels
ENDIF
IF (.NOT.GNORTH) THEN
#ifndef MNH_GPUDIRECT
!$acc update device(ZNORTHC_OUT) async(IS_NORTH)
#endif
!$acc kernels async(IS_NORTH)
PSRC( 1:IIU , IJE+1:IJU , : ) = ZNORTHC_OUT ( 1:IIU , IJE+1:IJU , : )
!$acc end kernels
ENDIF
!$acc wait
END IF
!$acc end data
CALL MPPDB_CHECK(PSRC,"GET_HALO_DDC end:PSRC")
!CALL MPPDB_CHECK(PSRC,'UPDATE_HALO_ll::'//TRIM(HNAME))
END SUBROUTINE GET_HALO_DDC
#endif
!-----------------------------------------------------------------------
!
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme