From 41308c29c24a4105a27fc9d235077a3e883bc80c Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 11 Apr 2024 13:26:10 +0200
Subject: [PATCH] Philippe 11/04/2024: remove GATHERBOX_X2 subroutine
---
src/LIB/SURCOUCHE/src/mode_gather.f90 | 42 +--------------------------
1 file changed, 1 insertion(+), 41 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_gather.f90 b/src/LIB/SURCOUCHE/src/mode_gather.f90
index d57d47cf8..1e8526a91 100644
--- a/src/LIB/SURCOUCHE/src/mode_gather.f90
+++ b/src/LIB/SURCOUCHE/src/mode_gather.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2024 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.
@@ -1322,46 +1322,6 @@ END IF
END SUBROUTINE GATHERXY_L3
-SUBROUTINE GATHERBOX_X2(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX)
-USE MODD_IO, ONLY: ISP, ISNPROC
-
-REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PSEND
-REAL,DIMENSION(:,:),TARGET,INTENT(INOUT):: PRECV
-INTEGER, INTENT(IN) :: KROOT
-INTEGER, INTENT(IN) :: KCOMM
-INTEGER, INTENT(IN) :: KXOBOX,KXEBOX,KYOBOX,KYEBOX
-
-INTEGER :: JI
-INTEGER :: IXO,IXE,IYO,IYE
-REAL, DIMENSION(:,:), POINTER :: XP
-INTEGER :: IERR
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-
-IF (ISP == KROOT) THEN
- ! I/O proc case
- DO JI=1,ISNPROC
- CALL GET_DOMWRITE_ll(JI,'global',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX)
- IF (IXO /= 0) THEN ! intersection is not empty
- XP=>PRECV(IXO:IXE,IYO:IYE)
- IF (ISP == JI) THEN
- CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX)
- XP = PSEND(IXO:IXE,IYO:IYE)
- ELSE
- CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
- END IF
- END IF
- END DO
-ELSE
- ! Other processes
- CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX)
- IF (IXO /= 0) THEN ! intersection is not empty
- XP=>PSEND(IXO:IXE,IYO:IYE)
- CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
- END IF
-END IF
-
-END SUBROUTINE GATHERBOX_X2
-
SUBROUTINE GET_DOMWRITE_ll(KIP,HTYPE,KXOR,KXEND,KYOR,KYEND,&
& KXORBOX,KXENDBOX,KYORBOX,KYENDBOX,HINTER)
--
GitLab