Skip to content
Snippets Groups Projects
Commit e3526a0c authored by Juan Escobar's avatar Juan Escobar
Browse files

Juan 1/08/2012 : add option to UPDATE_HALO in X or Y direction only , or NO... 

Juan 1/08/2012 : add option to UPDATE_HALO in X or Y direction only , or NO update at all <=> update_halo not really needeed
parent 404ac172
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
MNH/get_halo.f90
+ 5
− 3
View file @ e3526a0c
......@@ -18,9 +18,10 @@ TYPE(HALO2LIST_ll), POINTER :: TP_PSRC_HALO2_ll ! halo2 for SRC
!
END SUBROUTINE GET_HALO2
!
SUBROUTINE GET_HALO(PSRC)
SUBROUTINE GET_HALO(PSRC,HDIR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
END SUBROUTINE GET_HALO
!
......@@ -70,7 +71,7 @@ END SUBROUTINE GET_HALO2
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
! #########################
SUBROUTINE GET_HALO(PSRC)
SUBROUTINE GET_HALO(PSRC,HDIR)
! #########################
!
USE MODE_ll
......@@ -79,6 +80,7 @@ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
INTEGER :: IERROR ! error return code
......@@ -86,7 +88,7 @@ INTEGER :: IERROR ! error return code
NULLIFY( TZ_PSRC_ll)
!
CALL ADD3DFIELD_ll(TZ_PSRC_ll,PSRC)
CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR)
CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
CALL CLEANLIST_ll(TZ_PSRC_ll)
!
END SUBROUTINE GET_HALO
......
MNH/ppm.f90
+ 155
− 83
View file @ e3526a0c
This diff is collapsed.
SURCOUCHE/extern_usersurc_ll.f90
+ 3
− 55
View file @ e3526a0c
......@@ -1228,60 +1228,7 @@
END SUBROUTINE REDUCE_SUM_3D_ll
!
!! ##########################################
SUBROUTINE REDUCE_SUM_I0D_ll( PRES, KINFO )
!! ##########################################
!
USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I0D_ll => REDUCE_SUM_I0D_ll
!
INTEGER, INTENT(INOUT) :: PRES
INTEGER, INTENT(OUT) :: KINFO
!
CALL E_REDUCE_SUM_I0D_ll(PRES, KINFO)
!
END SUBROUTINE REDUCE_SUM_I0D_ll
!
!! ##########################################
SUBROUTINE REDUCE_SUM_I1D_ll( PRES, KINFO )
!! ##########################################
!
USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I1D_ll => REDUCE_SUM_I1D_ll
!
INTEGER, DIMENSION(:), INTENT(INOUT) :: PRES
INTEGER, INTENT(OUT) :: KINFO
!
CALL E_REDUCE_SUM_I1D_ll( PRES, KINFO )
!
END SUBROUTINE REDUCE_SUM_I1D_ll
!
!! ##########################################
SUBROUTINE REDUCE_SUM_I2D_ll( PRES, KINFO )
!! ##########################################
!
USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I2D_ll => REDUCE_SUM_I2D_ll
!
INTEGER, DIMENSION(:,:), INTENT(INOUT) :: PRES
INTEGER, INTENT(OUT) :: KINFO
!
CALL E_REDUCE_SUM_I2D_ll( PRES, KINFO )
!
END SUBROUTINE REDUCE_SUM_I2D_ll
!
!! ##########################################
SUBROUTINE REDUCE_SUM_I3D_ll( PRES, KINFO )
!! ##########################################
!
USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I3D_ll => REDUCE_SUM_I3D_ll
!
INTEGER, DIMENSION(:,:,:), INTENT(INOUT) :: PRES
INTEGER, INTENT(OUT) :: KINFO
!
CALL E_REDUCE_SUM_I3D_ll(PRES, KINFO)
!
END SUBROUTINE REDUCE_SUM_I3D_ll
!
!! ##########################################
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODE_EXCHANGE_ll, ONLY : E_UPDATE_HALO_ll => UPDATE_HALO_ll
......@@ -1290,8 +1237,9 @@
!
TYPE(LIST_ll), POINTER :: TPLIST
INTEGER :: KINFO
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
CALL E_UPDATE_HALO_ll( TPLIST, KINFO )
CALL E_UPDATE_HALO_ll( TPLIST, KINFO, HDIR=HDIR )
!
END SUBROUTINE UPDATE_HALO_ll
!
......
SURCOUCHE/mode_exchange_ll.f90
+ 143
− 51
View file @ e3526a0c
......@@ -87,7 +87,7 @@
CONTAINS
!
! ########################################
SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO)
SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO, HDIR )
! ########################################
!
!!**** *UPDATE_HALO_ll* - routine to update halo
......@@ -148,6 +148,7 @@
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
!* 0.2 declarations of local variables
!
......@@ -157,7 +158,7 @@
! -------------------------------------------------------------
!
CALL SEND_RECV_CRSPD(TCRRT_COMDATA%TSEND_HALO1, TCRRT_COMDATA%TRECV_HALO1, &
TPLIST, TPLIST, NHALO_COM, KINFO)
TPLIST, TPLIST, NHALO_COM, KINFO, HDIR=HDIR )
!
!* 2. UPDATE THE ZONES THE PROCESSOR SENDS OR RECEIVED FROM ITSELF
! ------------------------------------------------------------
......@@ -2111,7 +2112,7 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
! ##############################################################
SUBROUTINE SEND_RECV_CRSPD(TPCRSPDSEND, TPCRSPDRECV, &
TPFIELDLISTSEND, TPFIELDLISTRECV, &
KMPI_COMM, KINFO, KBARRIER)
KMPI_COMM, KINFO, KBARRIER, HDIR )
! ##############################################################
!
!!**** *SEND_RECV_CRSPD*-
......@@ -2208,6 +2209,8 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
INTEGER :: KMPI_COMM
INTEGER :: KINFO
INTEGER, OPTIONAL :: KBARRIER
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
!* 0.2 declarations of local variables
!
......@@ -2241,6 +2244,10 @@ INTEGER,SAVE,DIMENSION(MPI_MAX_REQ) :: REQ_TAB
INTEGER,SAVE,DIMENSION(MPI_STATUS_SIZE,MPI_MAX_REQ) :: STATUS_TAB
INTEGER :: NB_REQ,NFIRST_REQ_RECV
!endif
INTEGER :: IERR
!
LOGICAL :: GDIR_ALL , GLX , GLY
INTEGER :: INX , INY
! JUAN
!
!-------------------------------------------------------------------------------
......@@ -2252,6 +2259,10 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
.OR.(.NOT.ASSOCIATED(TPFIELDLISTRECV))) THEN
RETURN
ENDIF
!
! init test if only halo in some direction are need
!
CALL INIT_GOOD_DIR(HDIR)
!
IF (.NOT.ASSOCIATED(TPCRSPDSEND)) THEN
ISENDNB = 0
......@@ -2315,29 +2326,31 @@ endif
! Build the send buffer
TZZONESEND => TPMAILSEND%TELT
IF (TZZONESEND%NUMBER /= IP) THEN
JINC = 0
! JUAN
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,NB_REQ), JINC)
else
CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,1), JINC)
endif
! JUAN
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
CALL MPI_BSEND(TZBUFFER, JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, KERROR)
else
IF ( GOOD_DIR(TPMAILSEND) ) THEN
JINC = 0
! JUAN
!if defined (MNH_MPI_ISEND)
CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,NB_REQ), JINC)
else
CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,1), JINC)
endif
! JUAN
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
CALL MPI_BSEND(TZBUFFER, JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, KERROR)
else
! JUAN
!if defined (MNH_MPI_ISEND)
CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
endif
endif
ENDIF
ENDIF
ENDIF
TPMAILSEND => TPMAILSEND%TNEXT
ENDIF
ENDDO
......@@ -2355,24 +2368,26 @@ endif
IF (TPMAILRECV%TELT%NUMBER == IP) THEN
TPMAILRECV => TPMAILRECV%TNEXT
ELSE
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MPI_PRECISION, &
TPMAILRECV%TELT%NUMBER -1 , &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
else
CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MPI_PRECISION, &
TPMAILRECV%TELT%NUMBER -1 , &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, IRECVSTATUS, KERROR)
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,1), JINC)
endif
! JUAN
TPMAILRECV => TPMAILRECV%TNEXT
!
IF ( GOOD_DIR(TPMAILRECV) ) THEN
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MPI_PRECISION, &
TPMAILRECV%TELT%NUMBER -1 , &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
else
CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MPI_PRECISION, &
TPMAILRECV%TELT%NUMBER -1 , &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, IRECVSTATUS, KERROR)
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,1), JINC)
endif
! JUAN
TPMAILRECV => TPMAILRECV%TNEXT
!
END IF
ENDIF
!
......@@ -2390,14 +2405,15 @@ endif
IF (TPMAILRECV%TELT%NUMBER == IP) THEN
TPMAILRECV => TPMAILRECV%TNEXT
ELSE
!
NB_REQ = NB_REQ + 1
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,NB_REQ), JINC)
TPMAILRECV => TPMAILRECV%TNEXT
!
ENDIF
IF ( GOOD_DIR(TPMAILRECV) ) THEN
!
NB_REQ = NB_REQ + 1
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,NB_REQ), JINC)
TPMAILRECV => TPMAILRECV%TNEXT
!
END IF
ENDIF
!
ENDDO
endif
......@@ -2415,6 +2431,82 @@ endif
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE SEND_RECV_CRSPD
!
CONTAINS
SUBROUTINE INIT_GOOD_DIR(HDIR)
!
! init the direction of halo if needed
!
IMPLICIT NONE
CHARACTER(len=4), OPTIONAL :: HDIR
!
IF (.NOT. PRESENT(HDIR)) THEN
GDIR_ALL = .TRUE.
ELSE
!print*,"GOOD_DIR HDIR=",HDIR,"####"
GDIR_ALL = .FALSE.
INX = 0
INY = 0
GLX = .FALSE.
GLY = .FALSE.
IF ( HDIR == "Z0_X" ) THEN
!print*,"ZZZZZ0000_XXXXXXXXXXXXXXXX"
!GDIR_ALL = .TRUE.
INX = -100 ! -100 also OK so not really needed !!!
GLX = .TRUE.
ELSEIF ( HDIR == "S0_X" ) THEN
!print*,"SSSSS0000_XXXXXXXXXXXXXXXX"
GDIR_ALL = .TRUE.
INX = 1
GLX = .TRUE.
ELSEIF ( HDIR == "Z0_Y" ) THEN
!print*,"ZZZZZ0000_YYYYYYYYYYYYYYY"
!GDIR_ALL = .TRUE.
INY = -100 ! -100 also OK so not really needed !!!
GLY = .TRUE.
ELSEIF ( HDIR == "S0_Y" ) THEN
!print*,"SSSS0000_YYYYYYYYYYYYYYY"
GDIR_ALL = .TRUE.
INY = 1
GLY = .TRUE.
ELSEIF ( HDIR == "01_X" ) THEN
!print*,"01_X"
!GDIR_ALL = .TRUE.
INX = 1
GLX = .TRUE.
ELSEIF ( HDIR == "Z1_X" ) THEN
!print*,"ZZZZZZZZZZZZZZZZ1_X"
!GDIR_ALL = .TRUE.
INX = -100
GLX = .TRUE.
ELSEIF ( HDIR == "01_Y" ) THEN
!print*,"01_YYYYYYYYYYYYY"
!GDIR_ALL = .TRUE.
INY = 1
GLY = .TRUE.
ELSE
print*,"GOOD_DIR DEFAULT :: SOMETHING WRONG !!! HDIR=",HDIR,"####"
STOP "INIT_GOOD_DIR :: SOMETHING WRONG !!! "
END IF
END IF
END SUBROUTINE INIT_GOOD_DIR
!
LOGICAL FUNCTION GOOD_DIR(TP)
IMPLICIT NONE
type(crspd_ll) :: TP
!
GOOD_DIR = .FALSE.
! RETURN
IF (GDIR_ALL) THEN
GOOD_DIR = .TRUE.
ELSEIF ( GLX ) THEN
GOOD_DIR = ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) == INX ) .AND. ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) /= INX )
ELSEIF ( GLY ) THEN
GOOD_DIR = ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) == INY ) .AND. ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) /= INY )
END IF
!
END FUNCTION GOOD_DIR
!
END SUBROUTINE SEND_RECV_CRSPD
!
END MODULE MODE_EXCHANGE_ll
SURCOUCHE/modi_update_ll.f90
+ 2
− 1
View file @ e3526a0c
......@@ -15,13 +15,14 @@
INTERFACE
!
!! ##########################################
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
END SUBROUTINE UPDATE_HALO_ll
!
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

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