diff --git a/src/MNH/adv_boundaries.f90 b/src/MNH/adv_boundaries.f90
index 764aa3c30e5cd522e7b63aebcf2a3bcb3052877e..fbbcf5786acf4ccab26b688ff1fe3a9dc6b854ea 100644
--- a/src/MNH/adv_boundaries.f90
+++ b/src/MNH/adv_boundaries.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 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.
@@ -168,10 +168,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
!
!* 0.2 declarations of local variables
!
-INTEGER :: IKB ! indice K Beginning in z direction
-INTEGER :: IKE ! indice K End in z direction
-INTEGER :: IIU, IJU ! Index End in X and Y directions
-INTEGER :: IIB,IIE,IJB,IJE ! interior domaine bound
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: IIU, IJU ! Index End in X and Y directions
+INTEGER :: IIB,IIE,IJB,IJE ! interior domaine bound
+LOGICAL :: GNORTH, GSOUTH, GWEST, GEAST
!
!-------------------------------------------------------------------------------
IF (SIZE(PFIELD)==0) RETURN
@@ -188,6 +189,11 @@ IKB = 1 + JPVEXT
IKE = SIZE(PFIELD,3) - JPVEXT
IIU=SIZE(PFIELD,1)
IJU=SIZE(PFIELD,2)
+
+GWEST = ( HLBCX(1) == 'OPEN' .AND. LWEST_ll() )
+GEAST = ( HLBCX(2) == 'OPEN' .AND. LEAST_ll() )
+GSOUTH = ( HLBCY(1) == 'OPEN' .AND. LSOUTH_ll() )
+GNORTH = ( HLBCY(2) == 'OPEN' .AND. LNORTH_ll() )
!
!
!$acc kernels
@@ -211,16 +217,16 @@ IJU=SIZE(PFIELD,2)
!* 3. LATERAL BC FILLING
! ---------------------------
!
- IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ IF ( GWEST ) THEN
PFIELD(:IIB-1,:,:) = PFIELDI(:IIB-1,:,:)
END IF
- IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ IF ( GEAST ) THEN
PFIELD(IIE+1:,:,:) = PFIELDI(IIE+1:,:,:)
END IF
- IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ IF ( GSOUTH ) THEN
PFIELD(:,:IJB-1,:) = PFIELDI(:,:IJB-1,:)
END IF
- IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ IF ( GNORTH ) THEN
PFIELD(:,IJE+1:,:) = PFIELDI(:,IJE+1:,:)
END IF
!$acc end kernels
@@ -229,16 +235,16 @@ IJU=SIZE(PFIELD,2)
!Not enough?
!$acc update self(PFIELD(:,:,IKB-1))
!$acc update self(PFIELD(:,:,IKE+1))
- IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ IF ( GWEST ) THEN
!$acc update self(PFIELD(1,:,:))
END IF
- IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ IF ( GEAST ) THEN
!$acc update self(PFIELD(IIU,:,:))
END IF
- IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ IF ( GSOUTH ) THEN
!$acc update self(PFIELD(:,1,:))
END IF
- IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ IF ( GNORTH ) THEN
!$acc update self(PFIELD(:,IJU,:))
END IF
#else
@@ -284,11 +290,12 @@ CHARACTER(LEN=1), INTENT(IN) :: HFIELD ! Field type
!
!* 0.2 declarations of local variables
!
-INTEGER :: IKB ! indice K Beginning in z direction
-INTEGER :: IKE ! indice K End in z direction
-INTEGER :: IIU, IJU ! Index End in X and Y directions
-INTEGER :: IIB,IIE,IJB,IJE ! interior domaine bound
-INTEGER :: IFLAG ! Variable to workaround a performance problem with PGI compiler (at least 16.4)
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: IIU, IJU ! Index End in X and Y directions
+INTEGER :: IIB,IIE,IJB,IJE ! interior domaine bound
+INTEGER :: IFLAG ! Variable to workaround a performance problem with PGI compiler (at least 16.4)
+LOGICAL :: GNORTH, GSOUTH, GWEST, GEAST
!
!-------------------------------------------------------------------------------
IF (SIZE(PFIELD)==0) RETURN
@@ -305,8 +312,12 @@ IKB = 1 + JPVEXT
IKE = SIZE(PFIELD,3) - JPVEXT
IIU=SIZE(PFIELD,1)
IJU=SIZE(PFIELD,2)
-!
-!
+
+GWEST = ( HLBCX(1) == 'OPEN' .AND. LWEST_ll() )
+GEAST = ( HLBCX(2) == 'OPEN' .AND. LEAST_ll() )
+GSOUTH = ( HLBCY(1) == 'OPEN' .AND. LSOUTH_ll() )
+GNORTH = ( HLBCY(2) == 'OPEN' .AND. LNORTH_ll() )
+
SELECT CASE (HFIELD)
CASE ('U')
IFLAG = 1
@@ -343,20 +354,20 @@ END SELECT
!* 3. LATERAL BC FILLING
! ---------------------------
!
- IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ IF ( GWEST ) THEN
PFIELD(:IIB-1,:,:) = PFIELDI(:IIB-1,:,:)
IF (IFLAG==1) & !HFIELD=='U'
PFIELD(:IIB,:,:) = PFIELDI(:IIB,:,:)
END IF
- IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ IF ( GEAST ) THEN
PFIELD(IIE+1:,:,:) = PFIELDI(IIE+1:,:,:)
END IF
- IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ IF ( GSOUTH ) THEN
PFIELD(:,:IJB-1,:) = PFIELDI(:,:IJB-1,:)
IF (IFLAG==2) & !HFIELD=='V'
PFIELD(:,:IJB,:) = PFIELDI(:,:IJB,:)
END IF
- IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ IF ( GNORTH ) THEN
PFIELD(:,IJE+1,:) = PFIELDI(:,IJE+1,:)
END IF
!
@@ -370,16 +381,16 @@ END SELECT
!add also if hfield =u or v
!$acc update self(PFIELD(:,:,IKB-1))
!$acc update self(PFIELD(:,:,IKE+1))
- IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ IF ( GWEST ) THEN
!$acc update self(PFIELD(1,:,:))
END IF
- IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ IF ( GEAST ) THEN
!$acc update self(PFIELD(IIU,:,:))
END IF
- IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ IF ( GSOUTH ) THEN
!$acc update self(PFIELD(:,1,:))
END IF
- IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ IF ( GNORTH ) THEN
!$acc update self(PFIELD(:,IJU,:))
END IF
#else
diff --git a/src/MNH/advec_weno_k_2_aux.f90 b/src/MNH/advec_weno_k_2_aux.f90
index bff1ae2d720d538e877154a2cd16dd0068ed5609..7947229dc69db8025abcfb0993551e6e7e58cd79 100644
--- a/src/MNH/advec_weno_k_2_aux.f90
+++ b/src/MNH/advec_weno_k_2_aux.f90
@@ -298,6 +298,8 @@ INTEGER :: IIE,IJE ! End useful area in x,y,z directions
INTEGER:: IW,IE,IWF,IEF ! Coordinate of third order diffusion area
!
INTEGER:: ILUOUT,IRESP ! for prints
+LOGICAL :: GWEST, GEAST
+LOGICAL :: GCYCL
!
! intermediate reconstruction fluxes for positive wind case
!
@@ -356,6 +358,17 @@ END IF
IF ( HLBCX(1) == 'CYCL' ) call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_WENO_K_2_UX', 'OpenACC: CYCL not yet tested' )
#endif
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+
+IF ( HLBCX(1) == 'CYCL' ) THEN ! X direction LBC type: (1) for left side
+ GCYCL = .TRUE.
+ELSE IF ( ANY( HLBCX(1) == [ 'OPEN','WALL','NEST' ] ) ) THEN
+ GCYCL = .FALSE.
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'ADVEC_WENO_K_2_UX', 'invalid value (' // HLBCX(1) // ') for HLBCX(1)' )
+END IF
+
!$acc kernels
PR(:,:,:) = 0.0
!
@@ -374,11 +387,11 @@ ZOMN2 = 0.0
!
!-------------------------------------------------------------------------------
!
-SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+CYCL: IF ( GCYCL ) THEN
!
!* 1.1 CYCLIC CASE IN THE X DIRECTION:
!
-CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+! In that case one must have HLBCX(1) == HLBCX(2)
IW=IIB
IE=IIE
!
@@ -456,17 +469,17 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
(ZOMP2/(ZOMP1+ZOMP2) * ZFPOS2 + &
(ZOMP1/(ZOMP1+ZOMP2) * ZFPOS1)) * (0.5+SIGN(0.5,PRUCT))
!
+ELSE CYCL ! HLBCX(1) == ('OPEN','WALL','NEST')
!
! OPEN, WALL, NEST CASE IN THE X DIRECTION
!
-CASE ('OPEN','WALL','NEST')
!
IW=IIB
IE=IIE
!
! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
!
- IF(LWEST_ll()) THEN
+ IF( GWEST ) THEN
PR(IW-1,:,:) = PSRC(IW-1,:,:) * (0.5+SIGN(0.5,PRUCT(IW-1,:,:))) + PSRC(IW,:,:) * (0.5-SIGN(0.5,PRUCT(IW-1,:,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -510,7 +523,7 @@ CASE ('OPEN','WALL','NEST')
!
ENDIF
!
- IF(LEAST_ll()) THEN
+ IF( GEAST ) THEN
PR(IE,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE,:,:))) + PSRC(IE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IE,:,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -593,7 +606,7 @@ CASE ('OPEN','WALL','NEST')
(ZOMP2(IW:IE-1,:,:)/(ZOMP1(IW:IE-1,:,:)+ZOMP2(IW:IE-1,:,:)) * ZFPOS2(IW:IE-1,:,:) + &
(ZOMP1(IW:IE-1,:,:)/(ZOMP1(IW:IE-1,:,:)+ZOMP2(IW:IE-1,:,:)) * ZFPOS1(IW:IE-1,:,:))) * (0.5+SIGN(0.5,PRUCT(IW:IE-1,:,:)))
!
-END SELECT
+END IF CYCL
!
PR = PR * PRUCT
!$acc end kernels
@@ -680,6 +693,8 @@ INTEGER :: IIE,IJE ! End useful area in x,y,z directions
INTEGER:: IW,IE ! Coordinate of third order diffusion area
!
INTEGER:: ILUOUT,IRESP ! for prints
+LOGICAL :: GWEST, GEAST
+LOGICAL :: GCYCL
!
! intermediate reconstruction fluxes for positive wind case
!
@@ -739,6 +754,17 @@ END IF
IF ( HLBCX(1) == 'CYCL' ) call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_WENO_K_2_MX', 'OpenACC: CYCL not yet tested' )
#endif
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+
+IF ( HLBCX(1) == 'CYCL' ) THEN ! X direction LBC type: (1) for left side
+ GCYCL = .TRUE.
+ELSE IF ( ANY( HLBCX(1) == [ 'OPEN','WALL','NEST' ] ) ) THEN
+ GCYCL = .FALSE.
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'ADVEC_WENO_K_2_MX', 'invalid value (' // HLBCX(1) // ') for HLBCX(1)' )
+END IF
+
!$acc kernels
PR(:,:,:) = 0.0
!
@@ -757,11 +783,11 @@ ZOMN2 = 0.0
!
!------------------------------------------------------------------------------
!
-SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+CYCL: IF ( GCYCL ) THEN
!
!* 1.1 CYCLIC CASE IN THE X DIRECTION:
!
-CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+! In that case one must have HLBCX(1) == HLBCX(2)
IW=IIB
IE=IIE
!
@@ -840,17 +866,17 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
(ZOMN2/(ZOMN1+ZOMN2) * ZFNEG2 + &
(ZOMN1/(ZOMN1+ZOMN2) * ZFNEG1)) * (0.5-SIGN(0.5,PRUCT ))
!
+ELSE CYCL ! HLBCX(1) == ('OPEN','WALL','NEST')
!
! OPEN, WALL, NEST CASE IN THE X DIRECTION
!
-CASE ('OPEN','WALL','NEST')
!
IW=IIB
IE=IIE
!
! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
!
- IF(LWEST_ll()) THEN
+ IF( GWEST ) THEN
PR(IW,:,:) = PSRC(IW-1,:,:) * (0.5+SIGN(0.5,PRUCT(IW,:,:))) + PSRC(IW,:,:) * (0.5-SIGN(0.5,PRUCT(IW,:,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -894,7 +920,7 @@ CASE ('OPEN','WALL','NEST')
!
ENDIF
!
- IF(LEAST_ll()) THEN
+ IF( GEAST ) THEN
PR(IE+1,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) + PSRC(IE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -977,7 +1003,7 @@ CASE ('OPEN','WALL','NEST')
(ZOMN2(IW+1:IE,:,:)/(ZOMN1(IW+1:IE,:,:)+ZOMN2(IW+1:IE,:,:)) * ZFNEG2(IW+1:IE,:,:) + &
(ZOMN1(IW+1:IE,:,:)/(ZOMN1(IW+1:IE,:,:)+ZOMN2(IW+1:IE,:,:)) * ZFNEG1(IW+1:IE,:,:))) * (0.5-SIGN(0.5,PRUCT(IW+1:IE,:,:)))
!
-END SELECT
+END IF CYCL
!
PR = PR * PRUCT
!$acc end kernels
@@ -1065,6 +1091,8 @@ INTEGER :: IIE,IJE ! End useful area in x,y,z directions
INTEGER:: IS,IN ! Coordinate of third order diffusion area
!
INTEGER:: ILUOUT,IRESP ! for prints
+LOGICAL :: GNORTH, GSOUTH
+LOGICAL :: GCYCL
!
! intermediate reconstruction fluxes for positive wind case
!
@@ -1124,6 +1152,17 @@ END IF
IF ( HLBCY(1) == 'CYCL' ) call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_WENO_K_2_MY', 'OpenACC: CYCL not yet tested' )
#endif
+GNORTH = LNORTH_ll()
+GSOUTH = LSOUTH_ll()
+
+IF ( HLBCY(1) == 'CYCL' ) THEN ! Y direction LBC type: (1) for left side
+ GCYCL = .TRUE.
+ELSE IF ( ANY( HLBCY(1) == [ 'OPEN','WALL','NEST' ] ) ) THEN
+ GCYCL = .FALSE.
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'ADVEC_WENO_K_2_MY', 'invalid value (' // HLBCY(1) // ') for HLBCY(1)' )
+END IF
+
!$acc kernels
PR(:,:,:) = 0.0
!
@@ -1142,11 +1181,11 @@ ZOMN2 = 0.0
!
!-------------------------------------------------------------------------------
!
-SELECT CASE ( HLBCY(1) ) !
+CYCL: IF ( GCYCL ) THEN
!
!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
!
-CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
+! In that case one must have HLBCY(1) == HLBCY(2)
IS=IJB
IN=IJE
!
@@ -1223,17 +1262,17 @@ CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
(ZOMN2/(ZOMN1+ZOMN2) * ZFNEG2 + &
(ZOMN1/(ZOMN1+ZOMN2) * ZFNEG1)) * (0.5-SIGN(0.5,PRVCT))
!
+ELSE CYCL ! HLBCY(1) == ('OPEN','WALL','NEST')
!
! OPEN, WALL, NEST CASE IN THE Y DIRECTION
!
-CASE ('OPEN','WALL','NEST')
!
IS=IJB
IN=IJE
!
! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
!
- IF(LSOUTH_ll()) THEN
+ IF( GSOUTH ) THEN
PR(:,IS,:) = PSRC(:,IS-1,:) * (0.5+SIGN(0.5,PRVCT(:,IS,:))) + PSRC(:,IS,:) * (0.5-SIGN(0.5,PRVCT(:,IS,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -1277,7 +1316,7 @@ CASE ('OPEN','WALL','NEST')
!
ENDIF
!
- IF(LNORTH_ll()) THEN
+ IF( GNORTH ) THEN
PR(:,IN+1,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) + PSRC(:,IN+1,:) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -1360,7 +1399,7 @@ CASE ('OPEN','WALL','NEST')
(ZOMN2(:,IS+1:IN,:)/(ZOMN1(:,IS+1:IN,:)+ZOMN2(:,IS+1:IN,:)) * ZFNEG2(:,IS+1:IN,:) + &
(ZOMN1(:,IS+1:IN,:)/(ZOMN1(:,IS+1:IN,:)+ZOMN2(:,IS+1:IN,:)) * ZFNEG1(:,IS+1:IN,:))) * (0.5-SIGN(0.5,PRVCT(:,IS+1:IN,:)))
!
-END SELECT
+END IF CYCL
!
PR = PR * PRVCT
!$acc end kernels
@@ -1444,6 +1483,8 @@ INTEGER :: IIE,IJE ! End useful area in x,y,z directions
INTEGER:: IS,IN ! Coordinate of third order diffusion area
!
INTEGER:: ILUOUT,IRESP ! for prints
+LOGICAL :: GNORTH, GSOUTH
+LOGICAL :: GCYCL
!
! intermediate reconstruction fluxes for positive wind case
!
@@ -1503,6 +1544,17 @@ END IF
IF ( HLBCY(1) == 'CYCL' ) call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_WENO_K_2_VY', 'OpenACC: CYCL not yet tested' )
#endif
+GNORTH = LNORTH_ll()
+GSOUTH = LSOUTH_ll()
+
+IF ( HLBCY(1) == 'CYCL' ) THEN ! Y direction LBC type: (1) for left side
+ GCYCL = .TRUE.
+ELSE IF ( ANY( HLBCY(1) == [ 'OPEN','WALL','NEST' ] ) ) THEN
+ GCYCL = .FALSE.
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'ADVEC_WENO_K_2_VY', 'invalid value (' // HLBCY(1) // ') for HLBCY(1)' )
+END IF
+
!$acc kernels
PR(:,:,:) = 0.0
!
@@ -1521,11 +1573,11 @@ ZOMN2 = 0.0
!
!-------------------------------------------------------------------------------
!
-SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
+CYCL: IF ( GCYCL ) THEN
!
!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
!
-CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+! In that case one must have HLBCX(1) == HLBCX(2)
IS=IJB
IN=IJE
!
@@ -1599,17 +1651,17 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
(ZOMN2/(ZOMN1+ZOMN2) * ZFNEG2 + &
(ZOMN1/(ZOMN1+ZOMN2) * ZFNEG1)) * (0.5-SIGN(0.5,PRVCT))
!
+ELSE CYCL ! HLBCY(1) == ('OPEN','WALL','NEST')
!
! OPEN, WALL, NEST CASE IN THE Y DIRECTION
!
-CASE ('OPEN','WALL','NEST')
!
IS=IJB
IN=IJE
!
! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
!
- IF(LSOUTH_ll()) THEN
+ IF( GSOUTH ) THEN
PR(:,IS-1,:) = PSRC(:,IS-1,:) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) + PSRC(:,IS,:) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -1653,7 +1705,7 @@ CASE ('OPEN','WALL','NEST')
!
ENDIF
!
- IF(LNORTH_ll()) THEN
+ IF( GNORTH ) THEN
PR(:,IN,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN,:))) + PSRC(:,IN+1,:) * (0.5-SIGN(0.5,PRVCT(:,IN,:)))
!
!!$ ELSEIF (NHALO == 1) THEN
@@ -1736,7 +1788,7 @@ CASE ('OPEN','WALL','NEST')
(ZOMN2(:,IS:IN-1,:)/(ZOMN1(:,IS:IN-1,:)+ZOMN2(:,IS:IN-1,:)) * ZFNEG2(:,IS:IN-1,:) + &
(ZOMN1(:,IS:IN-1,:)/(ZOMN1(:,IS:IN-1,:)+ZOMN2(:,IS:IN-1,:)) * ZFNEG1(:,IS:IN-1,:))) * (0.5-SIGN(0.5,PRVCT(:,IS:IN-1,:)))
!
-END SELECT
+END IF CYCL
!
PR = PR * PRVCT
!$acc end kernels
diff --git a/src/MNH/contrav.f90 b/src/MNH/contrav.f90
index 99cfde5f47679858d6dc242b10ba602478179428..d5bec7557d2c9e929e2c780ebe2b9ea077ac818c 100644
--- a/src/MNH/contrav.f90
+++ b/src/MNH/contrav.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 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.
@@ -568,7 +568,9 @@ real :: ZTMP1, ZTMP2 ! Intermediate work variable
REAL, DIMENSION(:,:), ALLOCATABLE :: ZU_EAST, ZV_NORTH, ZDZX_EAST, ZDZY_NORTH
TYPE(LIST_ll), POINTER :: TZFIELD_U, TZFIELD_V, TZFIELD_DZX, TZFIELD_DZY
TYPE(HALO2LIST_ll), POINTER :: TZHALO2_U, TZHALO2_V, TZHALO2_DZX, TZHALO2_DZY
-
+!
+LOGICAL :: GWEST,GEAST,GSOUTH,GNORTH
+!
!$acc data present( PRUT, PRVT, PRWT, PDXX, PDYY, PDZZ, PDZX, PDZY, PRUCT, PRVCT, PRWCT, Z1, Z2 )
IF ( PRESENT(ODATA_ON_DEVICE) ) THEN
@@ -597,6 +599,11 @@ IIU= SIZE(PDXX,1)
IJU= SIZE(PDXX,2)
IKU= SIZE(PDXX,3)
!
+GWEST = ( HLBCX(1) /= 'CYCL' .AND. LWEST_ll() )
+GEAST = ( HLBCX(2) /= 'CYCL' .AND. LEAST_ll() )
+GSOUTH = ( HLBCY(1) /= 'CYCL' .AND. LSOUTH_ll() )
+GNORTH = ( HLBCY(2) /= 'CYCL' .AND. LNORTH_ll() )
+!
CALL GET_INDICE_ll( IIB,IJB,IIE,IJE)
!
IKB=1+JPVEXT
@@ -714,19 +721,19 @@ IF (KADV_ORDER == 2 ) THEN
ELSE IF (KADV_ORDER == 4 ) THEN
!
!!$ IF (NHALO == 1) THEN
- IF ( LWEST_ll() .AND. HLBCX(1)/='CYCL' ) THEN
+ IF ( GWEST ) THEN
IW=IIB+2 -1
ELSE
IW=IIB+1 -1
END IF
IE=IIE-1
!!$ ELSE
-!!$ IF (LWEST_ll()) THEN
+!!$ IF ( GWEST ) THEN
!!$ IW=IIB+1
!!$ ELSE
!!$ IW=IIB
!!$ END IF
-!!$ IF (LEAST_ll() .AND. HLBCX(2)/='CYCL' ) THEN
+!!$ IF ( GEAST ) THEN
!!$ IE=IIE-1
!!$ ELSE
!!$ IE=IIE
@@ -734,19 +741,19 @@ ELSE IF (KADV_ORDER == 4 ) THEN
!!$ END IF
!
!!$ IF(NHALO == 1) THEN
- IF ( LSOUTH_ll() .AND. HLBCY(1)/='CYCL' ) THEN
+ IF ( GSOUTH ) THEN
IS=IJB+2 -1
ELSE
IS=IJB+1 -1
END IF
IN=IJE-1
!!$ ELSE
-!!$ IF (LSOUTH_ll()) THEN
+!!$ IF ( GSOUTH ) THEN
!!$ IS=IJB+1
!!$ ELSE
!!$ IS=IJB
!!$ END IF
-!!$ IF (LNORTH_ll() .AND. HLBCY(2)/='CYCL' ) THEN
+!!$ IF ( GNORTH ) THEN
!!$ IN=IJE-1
!!$ ELSE
!!$ IN=IJE
@@ -818,24 +825,24 @@ ELSE IF (KADV_ORDER == 4 ) THEN
!
!* 3.3 non-CYCLIC CASE IN THE X DIRECTION: 2nd order case
!
- IF (HLBCX(1)/='CYCL' .AND. LWEST_ll()) THEN
+ IF ( GWEST ) THEN
Z1(IIB, :, IKB:IKE+1 ) = ( PRUCT(IIB, :, IKB:IKE+1 ) + PRUCT(IIB, :, IKB-1:IKE ) ) * PDZX(IIB, :, IKB:IKE+1 ) * 0.25 &
+ ( PRUCT(IIB+1, :, IKB:IKE+1 ) + PRUCT(IIB+1, :, IKB-1:IKE ) ) * PDZX(IIB+1, :, IKB:IKE+1 ) * 0.25
END IF
!
- IF (HLBCX(2)/='CYCL' .AND. LEAST_ll()) THEN
+ IF ( GEAST ) THEN
Z1(IIE, :, IKB:IKE+1 ) = ( PRUCT(IIE, :, IKB:IKE+1 ) + PRUCT(IIE, :, IKB-1:IKE ) ) * PDZX(IIE, :, IKB:IKE+1 ) * 0.25 &
+ ( PRUCT(IIE+1, :, IKB:IKE+1 ) + PRUCT(IIE+1, :, IKB-1:IKE ) ) * PDZX(IIE+1, :, IKB:IKE+1 ) * 0.25
END IF
!
!* 3.4 non-CYCLIC CASE IN THE Y DIRECTION: 2nd order case
!
- IF (HLBCY(1)/='CYCL' .AND. LSOUTH_ll()) THEN
+ IF ( GSOUTH ) THEN
Z2(:, IJB, IKB:IKE+1 ) = ( PRVCT(:, IJB, IKB:IKE+1 ) + PRVCT(:, IJB, IKB-1:IKE ) ) * PDZY(:, IJB, IKB:IKE+1 ) * 0.25 &
+ ( PRVCT(:, IJB+1, IKB:IKE+1 ) + PRVCT(:, IJB+1, IKB-1:IKE ) ) * PDZY(:, IJB+1, IKB:IKE+1 ) * 0.25
END IF
!
- IF (HLBCY(2)/='CYCL' .AND. LNORTH_ll()) THEN
+ IF ( GNORTH ) THEN
Z2(:, IJE, IKB:IKE+1 ) = ( PRVCT(:, IJE, IKB:IKE+1 ) + PRVCT(:, IJE, IKB-1:IKE ) ) * PDZY(:, IJE, IKB:IKE+1 ) * 0.25 &
+ ( PRVCT(:, IJE+1, IKB:IKE+1 ) + PRVCT(:, IJE+1, IKB-1:IKE ) ) * PDZY(:, IJE+1, IKB:IKE+1 ) * 0.25
END IF
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index d92cf49253ab29e2191c1acdbe1dd46dcb1794bd..9cba44767c60395aa6440284da266bce92d7574b 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -646,10 +646,10 @@ IKU=SIZE(PZZ,3)
!
IKL = 1
!
-GWEST = LWEST_ll()
-GEAST = LEAST_ll()
-GSOUTH = LSOUTH_ll()
-GNORTH = LNORTH_ll()
+GWEST = ( HLBCX(1) /= 'CYCL' .AND. LWEST_ll() )
+GEAST = ( HLBCX(2) /= 'CYCL' .AND. LEAST_ll() )
+GSOUTH = ( HLBCY(1) /= 'CYCL' .AND. LSOUTH_ll() )
+GNORTH = ( HLBCY(2) /= 'CYCL' .AND. LNORTH_ll() )
!
IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
ISVBEG = NSV_C2R2BEG
@@ -705,10 +705,10 @@ END DO
!
! complete the physical boundaries to avoid some computations
!
-IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
-IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
-IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
-IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
+IF(GWEST ) PRT(:IIB-1,:,:,2:) = 0.0
+IF(GEAST ) PRT(IIE+1:,:,:,2:) = 0.0
+IF(GSOUTH ) PRT(:,:IJB-1,:,2:) = 0.0
+IF(GNORTH ) PRT(:,IJE+1:,:,2:) = 0.0
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
DO JI=1,JPHEXT
@@ -720,10 +720,10 @@ END DO
!
! complete the physical boundaries to avoid some computations
!
- IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
- IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
- IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
- IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
+ IF(GWEST ) PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GEAST ) PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GSOUTH ) PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
+ IF(GNORTH ) PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
ENDIF
!
! complete the vertical boundaries
diff --git a/src/MNH/update_lm.f90 b/src/MNH/update_lm.f90
index a94f7c09ad3e473d49dee9bc2d56b818d68a7e2b..2c06c9cc50d03f427aa28d223fbe7177468b8049 100644
--- a/src/MNH/update_lm.f90
+++ b/src/MNH/update_lm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2022 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.
@@ -86,6 +86,7 @@ INTEGER :: IIE ! last physical index in x direction
INTEGER :: IJE ! last physical index in y direction
INTEGER :: JI ! loop index
!
+LOGICAL :: GNORTH, GSOUTH, GWEST, GEAST
TYPE(LIST_ll), POINTER :: TZLM_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
!
@@ -104,6 +105,11 @@ end if
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
NULLIFY(TZLM_ll)
!
+GWEST = ( HLBCX(1) /= 'CYCL' .AND. LWEST_ll() )
+GEAST = ( HLBCX(2) /= 'CYCL' .AND. LEAST_ll() )
+GSOUTH = ( HLBCY(1) /= 'CYCL' .AND. LSOUTH_ll() )
+GNORTH = ( HLBCY(2) /= 'CYCL' .AND. LNORTH_ll() )
+
!-------------------------------------------------------------------------------
!
!* 2. UPDATE HALOs :
@@ -125,21 +131,21 @@ NULLIFY(TZLM_ll)
! ---------------------------------------
!
!$acc kernels
-IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+IF ( GWEST ) THEN
PLM (IIB-1,:,:) = PLM (IIB,:,:)
PLEPS(IIB-1,:,:) = PLEPS(IIB,:,:)
END IF
-IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+IF ( GEAST ) THEN
PLM (IIE+1,:,:) = PLM (IIE,:,:)
PLEPS(IIE+1,:,:) = PLEPS(IIE,:,:)
END IF
-IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+IF ( GSOUTH ) THEN
DO JI=1,SIZE(PLM,1)
PLM (JI,IJB-1,:) = PLM (JI,IJB,:)
PLEPS(JI,IJB-1,:) = PLEPS(JI,IJB,:)
END DO
END IF
-IF ( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+IF ( GNORTH ) THEN
DO JI=1,SIZE(PLM,1)
PLM (JI,IJE+1,:) = PLM (JI,IJE,:)
PLEPS(JI,IJE+1,:) = PLEPS(JI,IJE,:)
diff --git a/src/ZSOLVER/update_lm.f90 b/src/ZSOLVER/update_lm.f90
index 18c03a1443cb785c3186f505ee027b8dc31b00b5..c8908734a4367db28a6f0e4c2bb62eb620e3df67 100644
--- a/src/ZSOLVER/update_lm.f90
+++ b/src/ZSOLVER/update_lm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2022 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.
@@ -90,6 +90,7 @@ INTEGER :: IIE ! last physical index in x direction
INTEGER :: IJE ! last physical index in y direction
INTEGER :: JI ! loop index
!
+LOGICAL :: GNORTH, GSOUTH, GWEST, GEAST
TYPE(LIST_ll), POINTER :: TZLM_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
!
@@ -110,6 +111,11 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
NULLIFY(TZLM_ll)
#endif
!
+GWEST = ( HLBCX(1) /= 'CYCL' .AND. LWEST_ll() )
+GEAST = ( HLBCX(2) /= 'CYCL' .AND. LEAST_ll() )
+GSOUTH = ( HLBCY(1) /= 'CYCL' .AND. LSOUTH_ll() )
+GNORTH = ( HLBCY(2) /= 'CYCL' .AND. LNORTH_ll() )
+
!-------------------------------------------------------------------------------
!
!* 2. UPDATE HALOs :
@@ -137,33 +143,33 @@ CALL GET_HALO_DDC( PLEPS, HNAME='UPDATE_LM::PLEPS' )
! ---------------------------------------
!
-IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+IF ( GWEST ) THEN
!$acc kernels async
PLM (IIB-1,:,:) = PLM (IIB,:,:)
PLEPS(IIB-1,:,:) = PLEPS(IIB,:,:)
!$acc end kernels
END IF
-IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+IF ( GEAST ) THEN
!$acc kernels async
PLM (IIE+1,:,:) = PLM (IIE,:,:)
PLEPS(IIE+1,:,:) = PLEPS(IIE,:,:)
!$acc end kernels
END IF
-IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
- !$acc kernels async
- DO JI=1,SIZE(PLM,1)
- PLM (JI,IJB-1,:) = PLM (JI,IJB,:)
- PLEPS(JI,IJB-1,:) = PLEPS(JI,IJB,:)
- END DO
- !$acc end kernels
+IF ( GSOUTH ) THEN
+ !$acc kernels async
+ DO JI=1,SIZE(PLM,1)
+ PLM (JI,IJB-1,:) = PLM (JI,IJB,:)
+ PLEPS(JI,IJB-1,:) = PLEPS(JI,IJB,:)
+ END DO
+ !$acc end kernels
END IF
-IF ( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
- !$acc kernels async
- DO JI=1,SIZE(PLM,1)
- PLM (JI,IJE+1,:) = PLM (JI,IJE,:)
- PLEPS(JI,IJE+1,:) = PLEPS(JI,IJE,:)
- END DO
- !$acc end kernels
+IF ( GNORTH ) THEN
+ !$acc kernels async
+ DO JI=1,SIZE(PLM,1)
+ PLM (JI,IJE+1,:) = PLM (JI,IJE,:)
+ PLEPS(JI,IJE+1,:) = PLEPS(JI,IJE,:)
+ END DO
+ !$acc end kernels
END IF
!$acc wait