diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 4e467082d9923068b982c5a07f8734fdce300d78..10ced03147ebf0d9bb2732f10b50a360e404a136 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -4240,7 +4240,7 @@ SUBROUTINE IO_Field_user_write(TPOUTPUT)
!
#if 0
USE MODD_DYN_n, ONLY: XTSTEP
-USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT
+USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT, XSVT
USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_PRECIP_n, ONLY: XINPRR
#endif
@@ -4317,6 +4317,19 @@ TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
!XACPRR is multiplied by 1000. to convert from m to kg m-2 (water density is assumed to be 1000 kg m-3)
CALL IO_Field_write(TPOUTPUT%TFILE,TZFIELD,XINPRR*XTSTEP*1.0E3)
+!
+TZFIELD%CMNHNAME = 'SVT001'
+TZFIELD%CSTDNAME = 'concentration in scalar variable'
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'kg kg-1'
+TZFIELD%CDIR = 'XY'
+TZFIELD%CCOMMENT = 'X_Y_Z_concentration in scalar variable'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPEREAL
+TZFIELD%NDIMS = 3
+TZFIELD%LTIMEDEP = .TRUE.
+CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XSVT(:,:,:,1))
+!
#endif
!
END SUBROUTINE IO_Field_user_write
diff --git a/src/MNH/addfluctuations.f90 b/src/MNH/addfluctuations.f90
new file mode 100644
index 0000000000000000000000000000000000000000..23019391d088349762496f61b62354856bcbe93c
--- /dev/null
+++ b/src/MNH/addfluctuations.f90
@@ -0,0 +1,177 @@
+!MNH_LIC Copyright 1994-2020 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.
+!-----------------------------------------------------------------
+!#####################
+MODULE MODI_ADDFLUCTUATIONS
+!#####################
+!
+INTERFACE
+!
+ SUBROUTINE ADDFLUCTUATIONS ( &
+ HLBCX,HLBCY, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT, &
+ PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE, &
+ PFLUCTWTW,PFLUCTWTN,PFLUCTWTS,PFLUCTWTE )
+
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE ! tengential velocity fluctuations
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTWTN,PFLUCTWTW,PFLUCTWTS,PFLUCTWTE ! vertical tengential velocity fluctuations
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+END SUBROUTINE ADDFLUCTUATIONS
+!
+END INTERFACE
+!
+END MODULE MODI_ADDFLUCTUATIONS
+!
+!
+! ####################################################################
+SUBROUTINE ADDFLUCTUATIONS ( &
+ HLBCX,HLBCY, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT, &
+ PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE, &
+ PFLUCTWTW,PFLUCTWTN,PFLUCTWTS,PFLUCTWTE )
+! ####################################################################
+!
+!!**** *ADDFLUCTUATIONS* - routine adding the velocity fluctuations to the
+!! Lateral Boundary Conditions for turbulence
+!! recycling purpose.
+!!
+!! PURPOSE
+!! -------
+!! EXTERNAL
+!! --------
+!! GET_INDICE_ll : get physical sub-domain bounds
+!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
+!!
+!! AUTHORS
+!! ------
+!! T.Nagel, V.Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+USE MODD_LBC_n, ONLY : XPOND
+USE MODD_RECYCL_PARAM_n
+USE MODE_MODELN_HANDLER
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE ! tengential velocity fluctuations
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTWTN,PFLUCTWTW,PFLUCTWTS,PFLUCTWTE ! vertical tengential velocity fluctuations
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB ! indice I Beginning in x direction
+INTEGER :: IJB ! indice J Beginning in y direction
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IIE ! indice I End in x direction
+INTEGER :: IJE ! indice J End in y direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: JI,JJ
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PUT,3) - JPVEXT
+!
+!* 2. ADD FLUCTUATIONS THE X DIRECTION (LEFT WEST SIDE):
+! ------------------------------------------------
+IF (LRECYCLW) THEN
+ IF (LWEST_ll( )) THEN
+ SELECT CASE ( HLBCX(1) )
+ CASE ('OPEN')
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PUT(JI,:,:)=0.
+ WHERE ( PUT(IIB,:,:) > 0. ) !INFLOW condition
+ PVT (JI,:,:) = PVT (JI,:,:)+XRCOEFF*PFLUCTVTW
+ PWT (JI,:,:) = PWT (JI,:,:)+XRCOEFF*PFLUCTWTW
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 3. ADD FLUCTUATIONS THE X DIRECTION (RIGHT EAST SIDE):
+! ------------------------------------------------
+IF (LRECYCLE) THEN
+ IF (LEAST_ll( )) THEN
+ SELECT CASE ( HLBCX(2) )
+ CASE ('OPEN')
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) < 0. ) !INFLOW condition
+ PVT (IIE+JI,:,:) = PVT (IIE+JI,:,:)+XRCOEFF*PFLUCTVTE
+ PWT (IIE+JI,:,:) = PWT (IIE+JI,:,:)+XRCOEFF*PFLUCTWTE
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 4. ADD FLUCTUATIONS THE Y DIRECTION (BOTTOM SOUTH SIDE):
+! ------------------------------------------------
+IF (LRECYCLS) THEN
+ IF (LSOUTH_ll( )) THEN
+ SELECT CASE ( HLBCY(1) )
+ CASE ('OPEN')
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PVT(:,JJ,:)=0.
+ WHERE ( PVT(:,IJB,:) > 0. ) !INFLOW condition
+ PUT (:,JJ,:) = PUT (:,JJ,:)+XRCOEFF*PFLUCTUTS
+ PWT (:,JJ,:) = PWT (:,JJ,:)+XRCOEFF*PFLUCTWTS
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 5. ADD FLUCTUATIONS THE Y DIRECTION (TOP NORTH SIDE):
+! ------------------------------------------------
+IF (LRECYCLN) THEN
+ IF (LNORTH_ll( )) THEN
+ SELECT CASE ( HLBCY(2) )
+ CASE ('OPEN')
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) < 0. ) !INFLOW condition
+ PUT (:,IJE+JJ,:) = PUT (:,IJE+JJ,:)+XRCOEFF*PFLUCTUTN
+ PWT (:,IJE+JJ,:) = PWT (:,IJE+JJ,:)+XRCOEFF*PFLUCTWTN
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADDFLUCTUATIONS
+
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 5426d3bde08b4c0c23229519ee6b0f46814cc259..850a0956cba76f891d8e9702f960c123085b029a 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -162,6 +162,8 @@ USE MODD_TYPE_DATE, ONLY: DATE_TIME
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_PARAMETERS
+USE MODD_IBM_PARAM_n, ONLY: LIBM,XIBM_LS,XIBM_EPSI
+USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
@@ -176,6 +178,7 @@ USE MODI_PPM_RHODJ
USE MODI_PPM_MET
USE MODI_PPM_SCALAR
!
+!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -338,6 +341,17 @@ IF (.NOT. L1D) THEN
ZCFLU(IIB:IIE,IJB:IJE,:) = ABS(ZRUCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLV(IIB:IIE,IJB:IJE,:) = ABS(ZRVCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
+ IF (LIBM) THEN
+ ZCFLU(IIB:IIE,IJB:IJE,:) = ZCFLU(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,2)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLV(IIB:IIE,IJB:IJE,:) = ZCFLV(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,3)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-XIBM_EPSI)) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-XIBM_EPSI)) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-XIBM_EPSI)) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
+ ENDIF
IF (.NOT. L2D) THEN
ZCFL = SQRT(ZCFLU**2+ZCFLV**2+ZCFLW**2)
ELSE
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
index 79168aa8d613162a8211d62b1440c4ab4db5f35c..133a1861df707d117c3b46529adc03ec4f478c86 100644
--- a/src/MNH/advecuvw_rk.f90
+++ b/src/MNH/advecuvw_rk.f90
@@ -105,6 +105,7 @@ END MODULE MODI_ADVECUVW_RK
!! C.Lac 10/16 : Correction on RK loop
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! T. Nagel,F.Auguste : 06/2021 : add IBM
!!
!-------------------------------------------------------------------------------
!
@@ -113,16 +114,21 @@ END MODULE MODI_ADVECUVW_RK
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll, HALO2LIST_ll
USE MODD_CONF, ONLY: NHALO
+USE MODD_IBM_PARAM_n, ONLY : LIBM, CIBM_ADV, XIBM_LS, XIBM_EPSI
USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_SUB_MODEL_n, ONLY : XT_IBM_FORC
!
USE MODE_ll
USE MODE_MPPDB
use mode_msg
!
USE MODI_ADV_BOUNDARIES
+USE MODI_ADVECUVW_2ND
USE MODI_ADVECUVW_4TH
USE MODI_ADVECUVW_WENO_K
USE MODI_GET_HALO
+USE MODI_IBM_FORCING_ADV
+USE MODI_SECOND_MNH
USE MODI_SHUMAN
!
!
@@ -169,7 +175,7 @@ INTEGER :: IKE ! indice K End in z direction
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUT, ZVT, ZWT
! Intermediate Guesses inside the RK loop
!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS,ZIBM
! Momentum tendencies due to advection
REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUT ! Butcher array coefficients
! at the RK sub time step
@@ -194,6 +200,7 @@ TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS4_ll ! list of fields to exchange
!
!
+REAL :: ZTIME1,ZTIME2
!-------------------------------------------------------------------------------
!
!* 0. INITIALIZATION
@@ -320,6 +327,15 @@ END SELECT
ALLOCATE(ZRUS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
ALLOCATE(ZRVS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
ALLOCATE(ZRWS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
+ALLOCATE(ZIBM(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3), 3)) ; ZIBM = 1.
+!
+IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
+
+ WHERE (XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZIBM(:,:,:,1) = 0.
+ WHERE (XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZIBM(:,:,:,2) = 0.
+ WHERE (XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZIBM(:,:,:,3) = 0.
+
+ENDIF
!
PRUS_ADV = 0.
PRVS_ADV = 0.
@@ -365,7 +381,12 @@ ZRWS = 0.
!* 4. Advection with WENO
! -------------------
!
-
+ IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
+ ZIBM(:,:,:,1)=ZRUS(:,:,:,JS)
+ ZIBM(:,:,:,2)=ZRVS(:,:,:,JS)
+ ZIBM(:,:,:,3)=ZRWS(:,:,:,JS)
+ ENDIF
+!
IF (HUVW_ADV_SCHEME=='WENO_K') THEN
CALL ADVECUVW_WENO_K (HLBCX, HLBCY, KWENO_ORDER, ZUT, ZVT, ZWT, &
PRUCT, PRVCT, PRWCT, &
@@ -377,6 +398,23 @@ ZRWS = 0.
ZRUS(:,:,:,JS), ZRVS(:,:,:,JS), ZRWS(:,:,:,JS), &
TZHALO2MT_ll )
ENDIF
+!
+ IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
+ IF (HUVW_ADV_SCHEME=='WENO_K') THEN
+ CALL ADVECUVW_WENO_K (HLBCX, HLBCY, 3, ZUT, ZVT, ZWT, &
+ PRUCT, PRVCT, PRWCT, &
+ ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3) ,&
+ TZHALO2MT_ll )
+ ENDIF
+ IF (HUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL ADVECUVW_2ND (ZUT, ZVT, ZWT, PRUCT, PRVCT, PRWCT, &
+ ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3))
+ ENDIF
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZIBM(:,:,:,1)
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZIBM(:,:,:,2)
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZIBM(:,:,:,3)
+ ZIBM(:,:,:,:)=1.
+ ENDIF
!
NULLIFY(TZFIELDS4_ll)
!
@@ -386,7 +424,20 @@ ZRWS = 0.
CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRWS(:,:,:,JS), 'ADVECUVW_RK::ZRWS(:,:,:,'//trim( adjustl( ynum ) )//')' )
CALL UPDATE_HALO_ll(TZFIELDS4_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS4_ll)
-!
+!
+ IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZUT(:,:,:)*PMXM_RHODJ/PTSTEP
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZVT(:,:,:)*PMYM_RHODJ/PTSTEP
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZWT(:,:,:)*PMZM_RHODJ/PTSTEP
+ ENDIF
+
+ IF (LIBM .AND. CIBM_ADV=='FORCIN') THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL IBM_FORCING_ADV(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ ENDIF
+!
IF ( JS /= ISPL ) THEN
!
ZUT = PU
@@ -398,11 +449,11 @@ ZRWS = 0.
! Intermediate guesses inside the RK loop
!
ZUT(:,:,:) = ZUT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
- ( ZRUS(:,:,:,JI) + PRUS_OTHER(:,:,:) ) / PMXM_RHODJ
+ ( ZRUS(:,:,:,JI) + PRUS_OTHER(:,:,:) ) / PMXM_RHODJ * ZIBM(:,:,:,1)
ZVT(:,:,:) = ZVT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
- ( ZRVS(:,:,:,JI) + PRVS_OTHER(:,:,:) ) / PMYM_RHODJ
+ ( ZRVS(:,:,:,JI) + PRVS_OTHER(:,:,:) ) / PMYM_RHODJ * ZIBM(:,:,:,2)
ZWT(:,:,:) = ZWT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
- ( ZRWS(:,:,:,JI) + PRWS_OTHER(:,:,:) ) / PMZM_RHODJ
+ ( ZRWS(:,:,:,JI) + PRWS_OTHER(:,:,:) ) / PMZM_RHODJ * ZIBM(:,:,:,3)
!
END DO
!
@@ -411,9 +462,9 @@ ZRWS = 0.
! Guesses at the end of the RK loop
!
DO JI = 1, ISPL
- PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JI) * ZRUS(:,:,:,JI)
- PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI)
- PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI)
+ PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JI) * ZRUS(:,:,:,JI) * ZIBM(:,:,:,1)
+ PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI) * ZIBM(:,:,:,2)
+ PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI) * ZIBM(:,:,:,3)
END DO
!
END IF
@@ -422,7 +473,7 @@ ZRWS = 0.
END DO
!
!
-DEALLOCATE(ZBUT, ZBUTS, ZRUS, ZRVS, ZRWS)
+DEALLOCATE(ZBUT, ZBUTS, ZRUS, ZRVS, ZRWS, ZIBM)
CALL CLEANLIST_ll(TZFIELDMT_ll)
CALL DEL_HALO2_ll(TZHALO2MT_ll)
!-------------------------------------------------------------------------------
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 67fcde53e1c09c8b078caa796bb1f4472f3a695d..960f34cbf154a52590a498524d839ebda930b474 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -208,6 +208,8 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+!! 02/2021 (F.Auguste,T.Nagel) add IBM defaults parameters
+!! 02/2021 (T.Nagel) add turbulence recycling defaults parameters
! P-A Joulin 21/05/2021: add Wind turbines
! S. Riette 21/05/2021: add options to PDF subgrid scheme
!
@@ -259,6 +261,7 @@ USE MODD_EOL_MAIN
USE MODD_EOL_ADNR
USE MODD_EOL_ALM
USE MODD_EOL_SHARED_IO
+USE MODD_ALLSTATION_n
!
!
USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS,&
@@ -285,6 +288,9 @@ USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_DRAG_n
USE MODD_VISCOSITY
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
@@ -511,6 +517,7 @@ XTNUDGING = 21600.
XIMPL = 1.
XKEMIN = 0.01
XCEDIS = 0.84
+XCADAP = 0.5
CTURBLEN = 'BL89'
CTURBDIM = '1DIM'
LTURB_FLX =.FALSE.
@@ -567,6 +574,22 @@ LTIMESPLIT = .FALSE.
LTIPLOSSG = .TRUE.
LTECOUTPTS = .FALSE.
!
+!------------------------------------------------------------------------------
+!* 10.e SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
+! ----------------------------------
+!
+NNUMB_STAT = 0
+XSTEP_STAT = 1.0
+XX_STAT(:) = XUNDEF
+XY_STAT(:) = XUNDEF
+XZ_STAT(:) = XUNDEF
+XLAT_STAT(:) = XUNDEF
+XLON_STAT(:) = XUNDEF
+CNAME_STAT(:) =" "
+CTYPE_STAT(:) =" "
+CFILE_STAT ="NO_INPUT_CSV"
+LDIAG_RESULTS = .FALSE.
+!
!-------------------------------------------------------------------------------
!
!* 11. SET DEFAULT VALUES FOR MODD_BUDGET :
@@ -1209,5 +1232,129 @@ IF (KMI == 1) THEN
XHSTART = 0.
ENDIF
!
+!-------------------------------------------------------------------------------
+!
+!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn
+! --------------------------------------
+!
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ XIBM_EPSI = 1.E-9
+ XIBM_IEPS = 1.E+9
+ NIBM_ITR = 8
+ XIBM_RUG = 0.01 ! (m^1.s^-0)
+ XIBM_VISC = 1.56e-5 ! (m^2.s^-1)
+ XIBM_CNU = 0.06 ! (m^0.s^-0)
+
+ NIBM_LAYER_P = 2
+ NIBM_LAYER_Q = 2
+ NIBM_LAYER_R = 2
+ NIBM_LAYER_S = 2
+ NIBM_LAYER_T = 2
+ NIBM_LAYER_E = 2
+ NIBM_LAYER_V = 2
+
+ XIBM_RADIUS_P = 2.
+ XIBM_RADIUS_Q = 2.
+ XIBM_RADIUS_R = 2.
+ XIBM_RADIUS_S = 2.
+ XIBM_RADIUS_T = 2.
+ XIBM_RADIUS_E = 2.
+ XIBM_RADIUS_V = 2.
+
+ XIBM_POWERS_P = 1.
+ XIBM_POWERS_Q = 1.
+ XIBM_POWERS_R = 1.
+ XIBM_POWERS_S = 1.
+ XIBM_POWERS_T = 1.
+ XIBM_POWERS_E = 1.
+ XIBM_POWERS_V = 1.
+
+ CIBM_MODE_INTE3_P = 'LAI'
+ CIBM_MODE_INTE3_Q = 'LAI'
+ CIBM_MODE_INTE3_R = 'LAI'
+ CIBM_MODE_INTE3_S = 'LAI'
+ CIBM_MODE_INTE3_T = 'LAI'
+ CIBM_MODE_INTE3_E = 'LAI'
+ CIBM_MODE_INTE3_V = 'LAI'
+
+ CIBM_MODE_INTE1_P = 'CL2'
+ CIBM_MODE_INTE1_Q = 'CL2'
+ CIBM_MODE_INTE1_R = 'CL2'
+ CIBM_MODE_INTE1_S = 'CL2'
+ CIBM_MODE_INTE1_T = 'CL2'
+ CIBM_MODE_INTE1_E = 'CL2'
+ CIBM_MODE_INTE1NV = 'CL2'
+ CIBM_MODE_INTE1TV = 'CL2'
+ CIBM_MODE_INTE1CV = 'CL2'
+
+ CIBM_MODE_BOUND_P = 'SYM'
+ CIBM_MODE_BOUND_Q = 'SYM'
+ CIBM_MODE_BOUND_R = 'SYM'
+ CIBM_MODE_BOUND_S = 'SYM'
+ CIBM_MODE_BOUND_T = 'SYM'
+ CIBM_MODE_BOUND_E = 'SYM'
+ CIBM_MODE_BOUNT_V = 'ASY'
+ CIBM_MODE_BOUNN_V = 'ASY'
+ CIBM_MODE_BOUNC_V = 'ASY'
+
+ XIBM_FORC_BOUND_P = 0.
+ XIBM_FORC_BOUND_Q = 0.
+ XIBM_FORC_BOUND_R = 0.
+ XIBM_FORC_BOUND_S = 0.
+ XIBM_FORC_BOUND_T = 0.
+ XIBM_FORC_BOUND_E = 0.
+ XIBM_FORC_BOUNN_V = 0.
+ XIBM_FORC_BOUNT_V = 0.
+ XIBM_FORC_BOUNC_V = 0.
+
+ CIBM_TYPE_BOUND_P = 'NEU'
+ CIBM_TYPE_BOUND_Q = 'NEU'
+ CIBM_TYPE_BOUND_R = 'NEU'
+ CIBM_TYPE_BOUND_S = 'NEU'
+ CIBM_TYPE_BOUND_T = 'NEU'
+ CIBM_TYPE_BOUND_E = 'NEU'
+ CIBM_TYPE_BOUNT_V = 'DIR'
+ CIBM_TYPE_BOUNN_V = 'DIR'
+ CIBM_TYPE_BOUNC_V = 'DIR'
+
+ CIBM_FORC_BOUND_P = 'CST'
+ CIBM_FORC_BOUND_Q = 'CST'
+ CIBM_FORC_BOUND_R = 'CST'
+ CIBM_FORC_BOUND_S = 'CST'
+ CIBM_FORC_BOUND_T = 'CST'
+ CIBM_FORC_BOUND_E = 'CST'
+ CIBM_FORC_BOUNN_V = 'CST'
+ CIBM_FORC_BOUNT_V = 'CST'
+ CIBM_FORC_BOUNC_V = 'CST'
+ CIBM_FORC_BOUNR_V = 'CST'
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
+! --------------------------------------
+!
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
+ XARECYCLN = 0.
+ XDRECYCLW = 0.
+ XARECYCLW = 0.
+ XDRECYCLS = 0.
+ XARECYCLS = 0.
+ XDRECYCLE = 0.
+ XARECYCLE = 0.
+ XTMOY = 0.
+ XTMOYCOUNT = 0.
+ XNUMBELT = 28.
+ XRCOEFF = 0.2
+ XTBVTOP = 500.
+ XTBVBOT = 300.
+!
!
END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index eb943082f866b2a7049e9c7e71327e8667d44719..0a5bb9704d5698fd1768635ebc90ccb3015215ff 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.f90
@@ -16,6 +16,8 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! 2017 V.Vionnet blow snow
! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+!! 02/21 (F.Auguste) add IBM
+!! 02/21 (T.Nagel) add turbulence recycling
!-----------------------------------------------------------------
MODULE MODI_GOTO_MODEL_WRAPPER
@@ -94,6 +96,7 @@ USE MODD_STATION_n
USE MODD_TURB_n
USE MODD_DRAG_n
USE MODD_BLOWSNOW_n
+USE MODD_ALLSTATION_n
!
USE MODD_SUB_CH_FIELD_VALUE_n
USE MODD_SUB_CH_MONITOR_n
@@ -125,6 +128,10 @@ USE MODD_CH_BUDGET_n
use mode_field, only: Fieldlist_goto_model
use mode_msg
!
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
+!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KFROM, KTO
@@ -206,6 +213,7 @@ CALL FRC_GOTO_MODEL(KFROM, KTO)
CALL SECPGD_FIELD_GOTO_MODEL(KFROM, KTO)
CALL SERIES_GOTO_MODEL(KFROM, KTO)
CALL STATION_GOTO_MODEL(KFROM, KTO)
+CALL ALLSTATION_GOTO_MODEL(KFROM, KTO)
CALL SUB_CH_FIELD_VALUE_GOTO_MODEL(KFROM, KTO)
CALL SUB_CH_MONITOR_GOTO_MODEL(KFROM, KTO)
CALL SUB_MODEL_GOTO_MODEL(KFROM, KTO)
@@ -235,6 +243,9 @@ CALL RELFRC_GOTO_MODEL(KFROM, KTO)
CALL CH_PRODLOSSTOT_GOTO_MODEL(KFROM,KTO)
CALL CH_BUDGET_GOTO_MODEL(KFROM,KTO)
CALL BLOWSNOW_GOTO_MODEL(KFROM, KTO)
+CALL IBM_GOTO_MODEL(KFROM, KTO)
+CALL RECYCL_GOTO_MODEL(KFROM, KTO)
+CALL LSF_GOTO_MODEL(KFROM, KTO)
!
IF (.NOT.GNOFIELDLIST) CALL FIELDLIST_GOTO_MODEL(KFROM, KTO)
!
diff --git a/src/MNH/ibm_0Dint.f90 b/src/MNH/ibm_0Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..81c90dc500246dd829d17aacabbcdf13b15780ba
--- /dev/null
+++ b/src/MNH/ibm_0Dint.f90
@@ -0,0 +1,218 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #####################
+MODULE MODI_IBM_0DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_0DINT(PDELTAI,PVALUEI,HBOUND1,HBOUND2,PBOUNDI,PIBM_VISC,PIBM_DIVK) RESULT(PVALUEB)
+ !
+ REAL , INTENT(IN) :: PDELTAI
+ REAL , INTENT(IN) :: PBOUNDI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND1
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND2
+ REAL , INTENT(IN) :: PIBM_VISC
+ REAL , INTENT(IN) :: PIBM_DIVK
+ REAL :: PVALUEB
+ !
+ END FUNCTION IBM_0DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_0DINT
+!
+! ###########################################################################
+FUNCTION IBM_0DINT(PDELTAI,PVALUEI,HBOUND1,HBOUND2,PBOUNDI,PIBM_VISC,PIBM_DIVK) RESULT(PVALUEB)
+ ! ###########################################################################
+ !
+ !**** *IBM_INTER_0DINT* - Computation of the variable value at the interface
+ !
+ ! PURPOSE
+ ! -------
+ ! Depending on the boundary condition type (Dirichlet, Neumann, Robin)
+ ! the variable value PVALUEB is affected using the values at images point
+ ! PVALUEI.
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_CST
+ USE MODD_CTURB
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL , INTENT(IN) :: PDELTAI
+ REAL , INTENT(IN) :: PBOUNDI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND1
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND2
+ REAL , INTENT(IN) :: PIBM_VISC
+ REAL , INTENT(IN) :: PIBM_DIVK
+ REAL :: PVALUEB
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ REAL :: Z_ROB, Z_PVAL0, Z_DVAL0
+ REAL :: Z_VD, Z_RD, Z_RE, Z_RD1, Z_RD2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Switch for Neuman,Dirichlet or Robin conditions
+ !
+ Z_ROB = 0.
+ !
+ IF (HBOUND1=='DIR') THEN
+ Z_ROB = 1.0
+ ENDIF
+ IF (HBOUND1=='NEU') THEN
+ Z_ROB = 0.0
+ ENDIF
+ IF (HBOUND1=='ROB') THEN
+ Z_ROB = 0.5
+ ENDIF
+ !
+ ! Computation of value at the interface
+ !
+ Z_PVAL0 = 0.
+ Z_DVAL0 = 0.
+ !
+ IF (HBOUND2=='CST') THEN
+ Z_PVAL0 = PBOUNDI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN3'.OR.HBOUND2=='CK3') THEN
+ Z_PVAL0 = PVALUEI(3)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN1'.OR.HBOUND2=='CK1') THEN
+ Z_PVAL0 = PVALUEI(1)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN2'.OR.HBOUND2=='CK2') THEN
+ Z_PVAL0 = PVALUEI(2)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN3'.OR.HBOUND2=='LK3') THEN
+ Z_PVAL0 = (2.*PVALUEI(3)-1.*PVALUEI(1))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN1'.OR.HBOUND2=='LK1') THEN
+ Z_PVAL0 = (2.*PVALUEI(1)-1.*PVALUEI(2))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN2'.OR.HBOUND2=='LK2') THEN
+ Z_PVAL0 = (1./4.)*(9.*PVALUEI(3)-6.*PVALUEI(1)+1.*PVALUEI(2))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN3'.OR.HBOUND2=='WK3') THEN
+ Z_VD = PVALUEI(3)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN1'.OR.HBOUND2=='WK1') THEN
+ Z_VD = PVALUEI(1)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN2'.OR.HBOUND2=='WK2') THEN
+ Z_VD = PVALUEI(2)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CK3'.OR.HBOUND2=='CK1'.OR.HBOUND2=='CK2'.OR.&
+ HBOUND2=='LK3'.OR.HBOUND2=='LK1'.OR.HBOUND2=='LK2'.OR.&
+ HBOUND2=='WK3'.OR.HBOUND2=='WK1'.OR.HBOUND2=='WK2') THEN
+ Z_VD = Z_PVAL0
+ Z_PVAL0 = Z_PVAL0*(1.-PIBM_DIVK)
+ IF (Z_PVAL0*Z_VD.LT.-XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ ENDIF
+ !
+ PVALUEB = Z_ROB*Z_PVAL0+(1.-Z_ROB)*(-PDELTAI*Z_DVAL0/2.+PVALUEI(3))
+ !
+ RETURN
+ !
+END FUNCTION IBM_0DINT
diff --git a/src/MNH/ibm_1Dint.f90 b/src/MNH/ibm_1Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f4522ae5f2b55e74f8568b8de897d49d3d6c021a
--- /dev/null
+++ b/src/MNH/ibm_1Dint.f90
@@ -0,0 +1,192 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #####################
+MODULE MODI_IBM_1DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_1DINT(PLOCATI,PVALUEI,HINTERP) RESULT(PVALUEG)
+ !
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL :: PVALUEG
+ !
+ END FUNCTION IBM_1DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_1DINT
+!
+! ###########################################################
+FUNCTION IBM_1DINT(PLOCATI,PVALUEI,HINTERP) RESULT(PVALUEG)
+ ! ###########################################################
+ !
+ !!**** *IBM_INTER_1DINT* - Classical Lagrange interpolation 1D
+ !!
+ !! PURPOSE
+ !! -------
+ ! This function interpolates the 1D fields from the image(s) point
+ ! to the mirror point associated to each ghost nodes. The interpolation
+ ! weighting is based on the Lagrange polynomials between the image point
+ ! F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi). The number of
+ ! nodes is depending on the interpolation order. The direction of the
+ ! interpolation is normal to the interface.
+ !
+ !!
+ !! METHOD
+ !! ------
+ !!
+ ! F(X,Y,Z)= sum(i=1toN)sum(j=1toN)sum(k=1toN)[[[Li(x)Lj(y)Lz(k)F(Xi,Yi,Zi)]]]
+ ! where La(B)=prod(l=1toN,l/=a) (B-Bl)/(Bb-Bl)
+ !
+ ! Three interpolations type is implemented. Each type uses respectively
+ ! MIRROR : computation of the mirror of the ghost
+ ! IMAGE1 : one image point with an imposed distance to the interface (1.V_cell**1/3)
+ ! IMAGE2 : a secund image with an imposed distance to the interface (2.V_cell**1/3)
+ !
+ !! INDEX
+ !! -----
+ !!
+ ! PLOCATI(1) (resp. PVALUEI(1)) is the image 1 location (resp. value) === CL0 ===
+ ! PLOCATI(2) (resp. PVALUEI(2)) is the image 2 location (resp. value) === CL1 ===
+ ! PLOCATI(3) (resp. PVALUEI(3)) is the mirror location (resp. value) === CL2 ===
+ ! PVALUEI(4) is the bound value
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !!
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL :: PVALUEG
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ REAL :: Z_PLAG_G0,Z_PLAG_I1,Z_PLAG_I2
+ REAL :: Z_CINT_G0,Z_CINT_I1,Z_CINT_I2
+ REAL :: Z_CINT_GG,Z_CINT_II
+ REAL :: Z_PLAG_GG,Z_PLAG_II
+ REAL :: ZVALUEMIN,ZVALUEMAX
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ IF (HINTERP=='CL3') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_G0 = (-PLOCATI(3)-PLOCATI(1))/(0. -PLOCATI(1))*&
+ (-PLOCATI(3)-PLOCATI(2))/(0. -PLOCATI(2))
+ Z_PLAG_I1 = (-PLOCATI(3)-0. )/(+PLOCATI(1)- 0.)*&
+ (-PLOCATI(3)-PLOCATI(2))/(+PLOCATI(1)-PLOCATI(2))
+ Z_PLAG_I2 = (-PLOCATI(3)-0. )/(+PLOCATI(2)- 0.)*&
+ (-PLOCATI(3)-PLOCATI(1))/(+PLOCATI(2)-PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_G0 = Z_PLAG_G0
+ Z_CINT_I1 = Z_PLAG_I1
+ Z_CINT_I2 = Z_PLAG_I2
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_G0*PVALUEI(4)+Z_CINT_I1*PVALUEI(1)+Z_CINT_I2*PVALUEI(2)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL2') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_G0 = (PLOCATI(3)-PLOCATI(1))/(-PLOCATI(3)-PLOCATI(1))*&
+ (PLOCATI(3)-PLOCATI(2))/(-PLOCATI(3)-PLOCATI(2))
+ Z_PLAG_I1 = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(1)+PLOCATI(3))*&
+ (PLOCATI(3)-PLOCATI(2))/(+PLOCATI(1)-PLOCATI(2))
+ Z_PLAG_I2 = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(2)+PLOCATI(3))*&
+ (PLOCATI(3)-PLOCATI(1))/(+PLOCATI(2)-PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_G0 = 1./(1.+Z_PLAG_G0)*(2.*Z_PLAG_G0)
+ Z_CINT_I1 = 1./(1.+Z_PLAG_G0)*(1.*Z_PLAG_I1)
+ Z_CINT_I2 = 1./(1.+Z_PLAG_G0)*(1.*Z_PLAG_I2)
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_G0*PVALUEI(4)+Z_CINT_I1*PVALUEI(1)+Z_CINT_I2*PVALUEI(2)
+ !
+ ! Value limitation
+ ZVALUEMIN = +XIBM_IEPS
+ ZVALUEMAX = -XIBM_IEPS
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(1))
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(2))
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(4))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(1))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(2))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(4))
+ PVALUEG = MAX(PVALUEG,ZVALUEMIN)
+ PVALUEG = MIN(PVALUEG,ZVALUEMAX)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL1') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_GG = (PLOCATI(3)-PLOCATI(1))/(-PLOCATI(3)-PLOCATI(1))
+ Z_PLAG_II = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(3)+PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_GG = 1./(1.+Z_PLAG_GG)*(2.*Z_PLAG_GG)
+ Z_CINT_II = 1./(1.+Z_PLAG_GG)*(1.*Z_PLAG_II)
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_GG*PVALUEI(4)+Z_CINT_II*PVALUEI(1)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL0') THEN
+ !
+ PVALUEG = PVALUEI(3)
+ !
+ ENDIF
+ !
+ RETURN
+ !
+END FUNCTION IBM_1DINT
diff --git a/src/MNH/ibm_3Dint.f90 b/src/MNH/ibm_3Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f57eec1afbb3175a912784d09702790ad85fd9e4
--- /dev/null
+++ b/src/MNH/ibm_3Dint.f90
@@ -0,0 +1,321 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #####################
+MODULE MODI_IBM_3DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_3DINT(KTYPUVW,PVALUEI,PLOCATI,PTESTG0,PLOCAT1,PVALUE1,PLOCAT2,HINTERP,PRADIUS,PPOWERS) RESULT(PVALUE2)
+ !
+ INTEGER :: KTYPUVW
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PTESTG0
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PLOCAT1
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUE1
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCAT2
+ REAL :: PVALUE2
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ !
+ END FUNCTION IBM_3DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_3DINT
+!
+! ###################################################################################################################
+FUNCTION IBM_3DINT(KTYPUVW,PVALUEI,PLOCATI,PTESTG0,PLOCAT1,PVALUE1,PLOCAT2,HINTERP,PRADIUS,PPOWERS) RESULT(PVALUE2)
+ ! ###################################################################################################################
+ !
+ !**** ===IBM_INTER_IDW=== inverse distance weighting interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the inverse of the (square of) the interpolation distance
+ ! between the image point F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi).
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|1/Di|F(Xi,Yi,Zi)] / sum(i=1toN)[|1/Di|]
+ ! Di as a power of the distance interpolation
+ !
+ !**** ===IBM_INTER_MDW=== modified inverse distance weighting interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the Franke formulation (2004) between the image point
+ ! F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi). The number of
+ ! nodes is depending on the interpolation order.
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|1/Di|F(Xi,Yi,Zi)] / sum(i=1toN)[|1/Di|]
+ ! Di according to :
+ ! "Scattered Data: tests of some methods."
+ ! Franke R., Mathematics of computation, 2004
+ !
+ !**** ===IBM_INTER_CLI=== classical Lagrange interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the trilinear interpolation via Lagrange polynomials
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|Li|F(Xi,Yi,Zi)]
+ ! Li = prod[(x-xj)(xi-xj)] (xi/=xj)
+ !
+ ! INDEX DEFINITION
+ ! ----------------
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ INTEGER :: KTYPUVW
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PTESTG0
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PLOCAT1
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUE1
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCAT2
+ REAL :: PVALUE2
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JM,JN,JMM ! loop index
+ REAL, DIMENSION(:), ALLOCATABLE :: Z_WEIGHT0 ! interpolation weighting array
+ REAL :: Z_WEIGHT1,Z_WEIGHT2,Z_WEIGHT3 ! interpolation weighting scalar
+ REAL :: Z_LENGHTX,Z_LENGHTY,Z_LENGHTZ ! interpolation distance
+ REAL :: Z_LENGHTM,Z_VOLUME,Z_VALUE3 ! interpolation module
+ REAL :: Z_ORDINT, Z_TESTSB,Z_VALUE2 ! interpolation radius
+ CHARACTER(LEN=3) :: Y_INTERP,Y_INTERP2
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(Z_WEIGHT0(10))
+ Z_WEIGHT0(:) = 0.
+ Z_WEIGHT1 = 0.
+ Z_WEIGHT2 = 0.
+ Z_WEIGHT3 = 0.
+ Z_VOLUME = 0.
+ Z_VALUE2 = 0.
+ Z_VALUE3 = 0.
+ JN = 0
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Switch interface distance dependence
+ !
+ Z_TESTSB = 1.
+ DO JN=1,8
+ Z_TESTSB = min(Z_TESTSB,PTESTG0(JN))
+ ENDDO
+ !
+ Y_INTERP = HINTERP
+ Y_INTERP2 = 'CLI'
+ IF (HINTERP=='LAI') THEN
+ IF (Z_TESTSB.lt.+XIBM_EPSI) THEN
+ Y_INTERP = 'IDW'
+ ELSE
+ Y_INTERP = 'CLI'
+ ENDIF
+ ENDIF
+ IF (HINTERP=='LAM') THEN
+ IF (Z_TESTSB.lt.+XIBM_EPSI) THEN
+ Y_INTERP = 'MDW'
+ ELSE
+ Y_INTERP = 'CLI'
+ ENDIF
+ ENDIF
+ !
+ ! === Trilinear Lagrange interpolation ===
+ !
+ IF (Y_INTERP=='CLI') THEN
+ !
+ DO JM=1,8
+ JN=8-JM+1
+ IF ((ABS((PLOCAT1(JM,1)-PLOCAT1(JN,1))).GT.XIBM_EPSI).AND.&
+ (ABS((PLOCAT1(JM,2)-PLOCAT1(JN,2))).GT.XIBM_EPSI).AND.&
+ (ABS((PLOCAT1(JM,3)-PLOCAT1(JN,3))).GT.XIBM_EPSI)) THEN
+ !
+ Z_WEIGHT0(JM)=(PLOCAT2(1)-PLOCAT1(JN,1))/(PLOCAT1(JM,1)-PLOCAT1(JN,1))*&
+ (PLOCAT2(2)-PLOCAT1(JN,2))/(PLOCAT1(JM,2)-PLOCAT1(JN,2))*&
+ (PLOCAT2(3)-PLOCAT1(JN,3))/(PLOCAT1(JM,3)-PLOCAT1(JN,3))
+ !
+ ELSE
+ !
+ Z_VALUE3 = 1.
+ Z_WEIGHT0(JM) = +XIBM_EPSI
+ !
+ ENDIF
+ ENDDO
+ !
+ IF (Z_VALUE3<XIBM_EPSI) THEN
+ !
+ DO JM=1,8
+ Z_VALUE2 = Z_VALUE2 + Z_WEIGHT0(JM)
+ ENDDO
+ IF (ABS(Z_VALUE2-1.)>0.1) THEN
+ Z_WEIGHT0(:) = 1./8.
+ ENDIF
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*Z_WEIGHT0(JM)
+ ENDDO
+ !
+ ELSE
+ !
+ Y_INTERP2 = 'IDW'
+ PVALUE2 = 0.
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (Y_INTERP2 == 'IDW') Y_INTERP = 'IDW'
+ !
+ ! === Inverse distance weighting interpolation (Modified or classical) ===
+ !
+ IF (Y_INTERP=='IDW'.or.Y_INTERP=='MDW') THEN
+ !
+ Z_VOLUME = ABS(PLOCAT1(1,1)-PLOCAT1(8,1))*&
+ ABS(PLOCAT1(1,2)-PLOCAT1(8,2))*&
+ ABS(PLOCAT1(1,3)-PLOCAT1(8,3))
+ !
+ JMM = 8
+ DO JM=1,JMM
+ !
+ IF (JM<=8) THEN
+ Z_LENGHTX = (PLOCAT2(1)-PLOCAT1(JM,1))
+ Z_LENGHTY = (PLOCAT2(2)-PLOCAT1(JM,2))
+ Z_LENGHTZ = (PLOCAT2(3)-PLOCAT1(JM,3))
+ ELSE
+ Z_LENGHTX = (PLOCAT2(1)-PLOCATI(1))
+ Z_LENGHTY = (PLOCAT2(2)-PLOCATI(2))
+ Z_LENGHTZ = (PLOCAT2(3)-PLOCATI(3))
+ ENDIF
+ Z_LENGHTM = (Z_LENGHTX**2.+Z_LENGHTY**2.+Z_LENGHTZ**2.)**0.5
+ !
+ Z_LENGHTM = MAX(Z_LENGHTM,0.0001*Z_VOLUME**(1./3.))
+ IF ((Z_LENGHTM.lt.(0.01*Z_VOLUME**(1./3.))).AND.(PTESTG0(JM).GT.0.5)) THEN
+ Z_WEIGHT1 = 2.*XIBM_IEPS
+ Z_WEIGHT3 = 1.
+ JN=JM
+ ELSE
+ Z_WEIGHT1 = 0.
+ IF (Z_LENGHTM.lt.PRADIUS*Z_VOLUME**(1./3.)) THEN
+ !
+ IF (JM<=8.and.Y_INTERP=='IDW') Z_WEIGHT1 = PTESTG0(JM)*(1./Z_LENGHTM)**PPOWERS
+ IF (JM==9.and.Y_INTERP=='IDW') Z_WEIGHT1 = (1./Z_LENGHTM)**PPOWERS
+ IF (JM<=8.and.Y_INTERP=='MDW') Z_WEIGHT1 = PTESTG0(JM)*((PRADIUS*Z_VOLUME**(1./3.)-Z_LENGHTM)/&
+ (PRADIUS*Z_VOLUME**(1./3.)*Z_LENGHTM))**PPOWERS
+ IF (JM==9.and.Y_INTERP=='MDW') Z_WEIGHT1 = ((PRADIUS*Z_VOLUME**(1./3.)-Z_LENGHTM)/&
+ (PRADIUS*Z_VOLUME**(1./3.)*Z_LENGHTM))**PPOWERS
+ ENDIF
+ ENDIF
+ !
+ Z_WEIGHT2 = Z_WEIGHT2+Z_WEIGHT1
+ Z_WEIGHT0(JM)=Z_WEIGHT1
+ !
+ ENDDO
+ !
+ Z_WEIGHT0(10)=Z_WEIGHT2
+ !
+ IF (Z_WEIGHT3.gt.XIBM_EPSI) THEN
+ Z_WEIGHT0(:)=0.
+ Z_WEIGHT0(JN)=1.
+ Z_WEIGHT0(10)=1.
+ ENDIF
+ !
+ IF (ABS(Z_WEIGHT0(10)).GT.XIBM_EPSI) THEN
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*Z_WEIGHT0(JM)/Z_WEIGHT0(10)
+ ENDDO
+ !
+ ELSE
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*(1./8.)
+ ENDDO
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ DEALLOCATE(Z_WEIGHT0)
+ !
+ RETURN
+ !
+END FUNCTION IBM_3DINT
diff --git a/src/MNH/ibm_affectp.f90 b/src/MNH/ibm_affectp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6d6f8ea3fb88fb46fb90bc339ab598efe87ebedf
--- /dev/null
+++ b/src/MNH/ibm_affectp.f90
@@ -0,0 +1,353 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_AFFECTP
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_AFFECTP(PVAR,KIBM_LAYER,PRADIUS,PPOWERS,&
+ HIBM_MODE_INTE1,HIBM_MODE_INTE3,&
+ HIBM_TYPE_BOUND,HIBM_MODE_BOUND,&
+ HIBM_FORC_BOUND,PIBM_FORC_BOUND,PXMU,PDIV)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PVAR
+ INTEGER , INTENT(IN) :: KIBM_LAYER
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE1
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_TYPE_BOUND
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_BOUND
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_FORC_BOUND
+ REAL , INTENT(IN) :: PIBM_FORC_BOUND
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PDIV
+ !
+ END SUBROUTINE IBM_AFFECTP
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_AFFECTP
+!
+! ########################################################
+SUBROUTINE IBM_AFFECTP(PVAR,KIBM_LAYER,PRADIUS,PPOWERS,&
+ HIBM_MODE_INTE1,HIBM_MODE_INTE3,&
+ HIBM_TYPE_BOUND,HIBM_MODE_BOUND,&
+ HIBM_FORC_BOUND,PIBM_FORC_BOUND,PXMU,PDIV)
+ ! ########################################################
+ !
+ !
+ !**** IBM_AFFECTP computes the variable PVAR on desired ghost points :
+ ! - the P type of the ghost/image
+ ! - the 3D interpolation mode (HIBM_MODE_INTE3)
+ ! - the 1D interpolation mode (HIBM_MODE_INTE1)
+ ! - the boundary condition (HIBM_TYPE_BOUND)
+ ! - the symmetry character (HIBM_MODE_BOUND)
+ !
+ !
+ ! PURPOSE
+ ! -------
+ !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
+ ! Solutions are computed in regard of the symmetry character of the solution:
+ ! HIBM_MODE_BOUND='SYME' (Symmetrical)
+ ! HIBM_MODE_BOUND='ASYM' (Anti-symmetrical)
+ ! The ghost value is depending on the variable value at the interface:
+ ! HIBM_TYPE_BOUND="NULL" (00 value)
+ ! HIBM_TYPE_BOUND="FREE" (I1 value)
+ ! HIBM_TYPE_BOUND="LINE" (linear evolution, only IMAGE2 type)
+ ! HIBM_TYPE_BOUND="LOGA" (logarithmic evol, only IMAGE2 type)
+ ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
+ ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
+ ! HIBM_MODE_INTE3 = "CLI" (Trilinear Lagrange interp. )
+ ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 1 points - MIRROR)
+ ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 2 points - IMAGE1)
+ ! HIBM_MODE_INTE1 = "CL3" (Lagrange Polynomials - 3 points - IMAGE2)
+
+ ! METHOD
+ ! ------
+ ! - loop on ghosts
+ ! - functions storage
+ ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
+ ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
+ ! - computation of the value at the interface
+ ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
+ ! - Affectation
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XEXNREF
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_3DINT
+ USE MODI_IBM_1DINT
+ USE MODI_IBM_0DINT
+ USE MODD_CST
+ USE MODD_CTURB
+ USE MODD_RADIATIONS_n
+ USE MODD_DYN_n
+ USE MODD_FIELD_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PVAR ! interpolated variable
+ INTEGER , INTENT(IN) :: KIBM_LAYER ! layer number
+ REAL , INTENT(IN) :: PRADIUS ! Radius for MDW
+ REAL , INTENT(IN) :: PPOWERS ! Power for IDW/MDW
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE1 ! interpolation 1D (normal)
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE3 ! interpolation 3D (isotropic)
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_TYPE_BOUND ! imposed variable at the interface
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_BOUND ! symm.-antisymm. solution
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_FORC_BOUND ! Neu,Dir,Rob CL
+ REAL , INTENT(IN) :: PIBM_FORC_BOUND
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PDIV
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JI2,JJ2,JK2 ! loop index
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
+ INTEGER :: I_GHOST_NUMB ! ghost number per layer
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_IMAG ! value at mirror/image1/image2
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS ! location of bound and ghost
+ CHARACTER(LEN=3) :: Y_TYPE_BOUND ! imposed variable at the interface
+ CHARACTER(LEN=3) :: Y_MODE_BOUND ! symm.-antisymm. solution
+ REAL :: Z_VALUE_GHOS,Z_DELTA_IMAG
+ REAL :: Z_FORC_BOUND,ZIBM_VISC,ZIBM_DIVK,ZSURF
+ REAL :: ZIBM_HALO
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ ALLOCATE(I_INDEX_CORN(3))
+ ALLOCATE(Z_LOCAT_CORN(8,3))
+ ALLOCATE(Z_VALUE_CORN(8))
+ ALLOCATE(Z_TESTS_CORN(8))
+ ALLOCATE(Z_LOCAT_IMAG(3,3))
+ ALLOCATE(Z_VALUE_IMAG(4))
+ ALLOCATE(Z_LOCAT_BOUN(3))
+ ALLOCATE(Z_LOCAT_GHOS(3))
+ !
+ !----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ I_INDEX_CORN(:) = 0
+ Z_LOCAT_CORN(:,:)= 0.
+ Z_VALUE_CORN(:) = 0.
+ Z_TESTS_CORN(:) = 0.
+ Z_LOCAT_IMAG(:,:)= 0.
+ Z_VALUE_IMAG(:) = 0.
+ Z_LOCAT_GHOS(:) = 0.
+ Z_LOCAT_BOUN(:) = 0.
+ Y_TYPE_BOUND = HIBM_TYPE_BOUND
+ Y_MODE_BOUND = HIBM_MODE_BOUND
+ Z_FORC_BOUND = PIBM_FORC_BOUND
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ DO JMM=1,KIBM_LAYER
+ !
+ ! searching number of ghosts
+ JM = size(NIBM_GHOST_P,1)
+ JI = 0
+ JJ = 0
+ JK = 0
+ DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
+ JI = NIBM_GHOST_P(JM,JMM,1,1)
+ JJ = NIBM_GHOST_P(JM,JMM,1,2)
+ JK = NIBM_GHOST_P(JM,JMM,1,3)
+ IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
+ ENDDO
+ I_GHOST_NUMB = JM
+ !
+ ! Loop on each P Ghosts
+ IF (I_GHOST_NUMB<=0) GO TO 666
+ DO JM = 1,I_GHOST_NUMB
+ !
+ ! ghost index/ls
+ JI = NIBM_GHOST_P(JM,JMM,1,1)
+ JJ = NIBM_GHOST_P(JM,JMM,1,2)
+ JK = NIBM_GHOST_P(JM,JMM,1,3)
+ IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
+ Z_LOCAT_GHOS(:) = XIBM_GHOST_P(JM,JMM,1,:)
+ Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_P(JM,JMM,1,1,:)-1.0*XIBM_IMAGE_P(JM,JMM,1,2,:)
+ ZIBM_HALO=1.
+ !
+ ! === IMAGE1/IMAGE2 computation ===
+ !
+ DO JN = 1,3
+ !
+ Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_P(JM,JMM,1 ,JN,:)
+ Z_DELTA_IMAG = ((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))**0.5
+ I_INDEX_CORN(:) = NIBM_IMAGE_P(JM,JMM,1,1,JN,:)
+ IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
+ IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,1)
+ Z_TESTS_CORN(:) = XIBM_TESTI_P(JM,JMM,1,1,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR,I_INDEX_CORN)
+ Z_VALUE_IMAG(JN) = IBM_3DINT(JN,Z_VALUE_IMAG,Z_LOCAT_BOUN,Z_TESTS_CORN,&
+ Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
+ HIBM_MODE_INTE3,PRADIUS,PPOWERS)
+ !
+ ENDDO
+ !
+ ZIBM_VISC = PXMU(JI,JJ,JK)
+ ZIBM_DIVK = PDIV(JI,JJ,JK)
+ !
+ JN = 4
+ Z_VALUE_IMAG(JN) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_IMAG,HIBM_TYPE_BOUND,HIBM_FORC_BOUND,Z_FORC_BOUND,ZIBM_VISC,ZIBM_DIVK)
+ !
+ ! === GHOST computation ===
+ !
+ ! functions storage
+ Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_P(JM,JMM,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_GHOST_P(JM,JMM,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_GHOST_P(JM,JMM,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+
+ IF ((Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG).AND.ZIBM_HALO>0.5) THEN
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_P(JM,JMM,1,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_P(JM,JMM,1,2,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,2,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ ELSE
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_P(JM,JMM,1,3,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,3,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_P(JM,JMM,1,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_VALUE_IMAG(2) = Z_VALUE_IMAG(1)
+ Z_VALUE_IMAG(1) = Z_VALUE_IMAG(3)
+ ENDIF
+ !
+ Z_VALUE_GHOS = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_IMAG,HIBM_MODE_INTE1)
+ !
+ JN = 3
+ I_INDEX_CORN(:) = NIBM_IMAGE_P(JM,JMM,1,1,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(XIBM_LS(:,:,:,1),I_INDEX_CORN)
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,1)
+ DO JL=1,8
+ IF (JL==1) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ ZSURF = ((Z_LOCAT_CORN(JL,1)-Z_LOCAT_BOUN(1))**2.+ &
+ (Z_LOCAT_CORN(JL,2)-Z_LOCAT_BOUN(2))**2.+ &
+ (Z_LOCAT_CORN(JL,3)-Z_LOCAT_BOUN(3))**2.)**0.5/(Z_DELTA_IMAG/2.)
+ IF ((ZSURF<1.).AND.(Z_VALUE_CORN(JL).LT.(XIBM_EPSI)).AND.((PVAR(JI2,JJ2,JK2)-Z_VALUE_IMAG(3))*(PVAR(JI2,JJ2,JK2)- &
+ Z_VALUE_IMAG(4)).GT.XIBM_EPSI)) THEN
+ PVAR(JI2,JJ2,JK2) = 0.5*PVAR(JI2,JJ2,JK2)+0.5*(Z_VALUE_IMAG(4)-(Z_VALUE_IMAG(3)-Z_VALUE_IMAG(4))* &
+ Z_VALUE_CORN(JL)/(Z_DELTA_IMAG/2.))
+ ENDIF
+ ENDDO
+ !
+ IF (Y_MODE_BOUND=='SYM') PVAR(JI,JJ,JK) = +Z_VALUE_GHOS
+ IF (Y_MODE_BOUND=='ASY') PVAR(JI,JJ,JK) = -Z_VALUE_GHOS + 2.*Z_VALUE_IMAG(4)
+ IF (Y_MODE_BOUND=='CST') PVAR(JI,JJ,JK) = Z_VALUE_IMAG(4)
+ !
+777 CONTINUE
+ ENDDO
+
+ ENDDO
+ !
+666 CONTINUE
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDEX_CORN)
+ DEALLOCATE(Z_LOCAT_CORN)
+ DEALLOCATE(Z_VALUE_CORN)
+ DEALLOCATE(Z_LOCAT_IMAG)
+ DEALLOCATE(Z_VALUE_IMAG)
+ DEALLOCATE(Z_LOCAT_BOUN)
+ DEALLOCATE(Z_LOCAT_GHOS)
+ DEALLOCATE(Z_TESTS_CORN)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_AFFECTP
diff --git a/src/MNH/ibm_affectv.f90 b/src/MNH/ibm_affectv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fb751fb4c38f112aacabaf3ab35269ef575e6857
--- /dev/null
+++ b/src/MNH/ibm_affectv.f90
@@ -0,0 +1,402 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_AFFECTV
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ END SUBROUTINE IBM_AFFECTV
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_AFFECTV
+!
+! ########################################################
+SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ ! ########################################################
+ !
+ !
+ !**** IBM_AFFECTV computes the variable PVAR on desired ghost points :
+ ! - the V type of the ghost/image
+ ! - the 3D interpolation mode (HIBM_MODE_INTE3)
+ ! - the 1D interpolation mode (HIBM_MODE_INTE1)
+ ! - the boundary condition (HIBM_TYPE_BOUND)
+ ! - the symmetry character (HIBM_MODE_BOUND)
+ ! - the forcing type (HIBM_FORC_BOUND)
+ ! - the forcing term (HIBM_FORC_BOUND)
+ ! Choice of forcing type is depending on
+ ! the normal, binormal, tangent vectors (N,C,T)
+ !
+ !
+ ! PURPOSE
+ ! -------
+ !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
+ ! Solutions are computed in regard of the symmetry character of the solution:
+ ! HIBM_MODE_BOUND = 'SYM' (Symmetrical)
+ ! HIBM_MODE_BOUND = 'ASY' (Anti-symmetrical)
+ ! The ghost value is depending on the variable value at the interface:
+ ! HIBM_TYPE_BOUND = "CST" (constant value)
+ ! HIBM_TYPE_BOUND = "LAW" (wall models)
+ ! HIBM_TYPE_BOUND = "LIN" (linear evolution, only IMAGE2 type)
+ ! HIBM_TYPE_BOUND = "LOG" (logarithmic evol, only IMAGE2 type)
+ ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
+ ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
+ ! HIBM_MODE_INTE3 = "LAG" (Trilinear Lagrange interp. )
+ ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL0" (Lagrange Polynomials - 1 points - MIRROR)
+ ! HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 2 points - IMAGE1)
+ ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 3 points - IMAGE2)
+ ! METHOD
+ ! ------
+ ! - loop on ghosts
+ ! - functions storage
+ ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
+ ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
+ ! - computation of the value at the interface
+ ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
+ ! - Affectation
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_FIELD_n
+ USE MODD_PARAM_n, ONLY: CTURB
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_LBC_n
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ !
+ ! interface
+ USE MODI_IBM_MIXINGLENGTH
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_3DINT
+ USE MODI_IBM_1DINT
+ USE MODI_IBM_0DINT
+ USE MODI_IBM_VALUEMAT1
+ USE MODI_IBM_VALUEMAT2
+ USE MODI_SHUMAN
+ USE MODD_DYN_n
+ USE MODD_FIELD_n
+ USE MODD_CST
+ USE MODD_CTURB
+ USE MODD_RADIATIONS_n
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JH,JLL ! loop index
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
+ INTEGER :: I_GHOST_NUMB ! ghost number per layer
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_IMAG,Z_VALUE_TEMP,Z_VALUE_ZLKE ! value at mirror/image1/image2
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS,Z_TEMP_ZLKE ! location of bound and ghost
+ REAL :: Z_DELTA_IMAG,ZIBM_VISC,ZIBM_DIVK
+ CHARACTER(LEN=3),DIMENSION(:), ALLOCATABLE :: Y_TYPE_BOUND,Y_FORC_BOUND,Y_MODE_BOUND,Y_MODE_INTE1
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_FORC_BOUND,Z_VALUE_GHOS
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_MAT1,Z_VALUE_MAT2
+ REAL :: ZIBM_HALO
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ ALLOCATE(I_INDEX_CORN(3))
+ ALLOCATE(Z_LOCAT_CORN(8,3))
+ ALLOCATE(Z_VALUE_CORN(8))
+ ALLOCATE(Z_TESTS_CORN(8))
+ ALLOCATE(Z_LOCAT_IMAG(3,3))
+ ALLOCATE(Z_VALUE_IMAG(4,3))
+ ALLOCATE(Z_VALUE_TEMP(4,3))
+ ALLOCATE(Z_LOCAT_BOUN(3))
+ ALLOCATE(Z_LOCAT_GHOS(3))
+ ALLOCATE(Z_VALUE_GHOS(3))
+ ALLOCATE(Y_TYPE_BOUND(3),Y_FORC_BOUND(3))
+ ALLOCATE(Y_MODE_BOUND(3),Y_MODE_INTE1(3))
+ ALLOCATE(Z_FORC_BOUND(3))
+ ALLOCATE(Z_VALUE_MAT1(3,3))
+ ALLOCATE(Z_VALUE_MAT2(3,3))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ I_INDEX_CORN(:) = 0
+ Z_LOCAT_CORN(:,:) = 0.
+ Z_VALUE_CORN(:) = 0.
+ Z_TESTS_CORN(:) = 0.
+ Z_LOCAT_IMAG(:,:) = 0.
+ Z_VALUE_IMAG(:,:) = 0.
+ Z_VALUE_TEMP(:,:) = 0.
+ Z_LOCAT_GHOS(:) = 0.
+ Z_LOCAT_BOUN(:) = 0.
+ Z_VALUE_GHOS(:) = 0.
+ Z_VALUE_MAT1(:,:) = 0.
+ Z_VALUE_MAT2(:,:) = 0.
+ IF (HVAR=='U') JH = 1
+ IF (HVAR=='V') JH = 2
+ IF (HVAR=='W') JH = 3
+ Y_TYPE_BOUND(1) = HIBM_TYPE_BOUNN
+ Y_TYPE_BOUND(2) = HIBM_TYPE_BOUNT
+ Y_TYPE_BOUND(3) = HIBM_TYPE_BOUNC
+ Y_FORC_BOUND(1) = HIBM_FORC_BOUNN
+ Y_FORC_BOUND(2) = HIBM_FORC_BOUNT
+ Y_FORC_BOUND(3) = HIBM_FORC_BOUNC
+ Y_MODE_BOUND(1) = HIBM_MODE_BOUNN
+ Y_MODE_BOUND(2) = HIBM_MODE_BOUNT
+ Y_MODE_BOUND(3) = HIBM_MODE_BOUNC
+ Y_MODE_INTE1(1) = HIBM_MODE_INT1N
+ Y_MODE_INTE1(2) = HIBM_MODE_INT1T
+ Y_MODE_INTE1(3) = HIBM_MODE_INT1C
+ Z_FORC_BOUND(1) = PIBM_FORC_BOUNN
+ Z_FORC_BOUND(2) = PIBM_FORC_BOUNT
+ Z_FORC_BOUND(3) = PIBM_FORC_BOUNC
+ !
+ ALLOCATE(Z_VALUE_ZLKE(4,3))
+ ALLOCATE(Z_TEMP_ZLKE(3))
+ Z_VALUE_ZLKE(:,:) = 0.
+ Z_TEMP_ZLKE(:) = 0.
+ !
+ DO JMM=1,KIBM_LAYER
+ !
+ ! searching number of ghosts
+ JM = size(NIBM_GHOST_V,1)
+ JI = 0
+ JJ = 0
+ JK = 0
+ DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
+ ENDDO
+ I_GHOST_NUMB = JM
+ !
+ ! Loop on each P Ghosts
+ IF (I_GHOST_NUMB<=0) GO TO 666
+ DO JM = 1,I_GHOST_NUMB
+ !
+ ! ghost index/ls
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
+ Z_LOCAT_GHOS(:) = XIBM_GHOST_V(JM,JMM,JH,:)
+ Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_V(JM,JMM,JH,1,:)-1.0*XIBM_IMAGE_V(JM,JMM,JH,2,:)
+ ZIBM_HALO = 1.
+ !
+ DO JN = 1,3
+ !
+ Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_V(JM,JMM,JH ,JN,:)
+ Z_DELTA_IMAG = ((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))**0.5
+ !
+ DO JLL=1,3
+ I_INDEX_CORN(:) = NIBM_IMAGE_V(JM,JMM,JH,JLL,JN,:)
+ IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
+ IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,JLL+1)
+ Z_TESTS_CORN(:) = XIBM_TESTI_V(JM,JMM,JH,JLL,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR2(:,:,:,JLL),I_INDEX_CORN)
+ Z_VALUE_IMAG(JN,JLL) = IBM_3DINT(JN,Z_VALUE_IMAG(:,JLL),Z_LOCAT_BOUN,Z_TESTS_CORN,&
+ Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
+ HIBM_MODE_INTE3,PRADIUS,PPOWERS)
+ ENDDO
+ !
+ ENDDO
+ ZIBM_VISC = PXMU(JI,JJ,JK)
+ ZIBM_DIVK = PDIV(JI,JJ,JK)
+ !
+ ! projection step
+ Z_VALUE_MAT1(:,:) = IBM_VALUEMAT1(Z_LOCAT_IMAG(1,:),Z_LOCAT_BOUN,Z_VALUE_IMAG,HIBM_FORC_BOUNR)
+ DO JN=1,3
+ Z_VALUE_TEMP(JN,:)= Z_VALUE_MAT1(:,1)*Z_VALUE_IMAG(JN,1) +&
+ Z_VALUE_MAT1(:,2)*Z_VALUE_IMAG(JN,2) +&
+ Z_VALUE_MAT1(:,3)*Z_VALUE_IMAG(JN,3)
+ ENDDO
+ !
+ ! === BOUND computation ===
+ !
+ JN=4
+ DO JLL=1,3
+ Z_VALUE_TEMP(JN,JLL) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_TEMP(:,JLL),Y_TYPE_BOUND(JLL),Y_FORC_BOUND(JLL), &
+ Z_FORC_BOUND(JLL),ZIBM_VISC,ZIBM_DIVK)
+ ENDDO
+ !
+ ! inverse projection step
+ Z_VALUE_MAT2(:,:) = IBM_VALUEMAT2(Z_VALUE_MAT1)
+ Z_VALUE_IMAG(JN,:)= Z_VALUE_MAT2(:,1)*Z_VALUE_TEMP(JN,1) +&
+ Z_VALUE_MAT2(:,2)*Z_VALUE_TEMP(JN,2) +&
+ Z_VALUE_MAT2(:,3)*Z_VALUE_TEMP(JN,3)
+ !
+ ! === GHOST computation ===
+ !
+ ! functions storage
+ Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_V(JM,JMM,JH,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ IF (Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG.AND.ZIBM_HALO>0.5) THEN
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,2,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ ELSE
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,3,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_VALUE_TEMP(2,:) = Z_VALUE_TEMP(1,:)
+ Z_VALUE_TEMP(1,:) = Z_VALUE_TEMP(3,:)
+ ENDIF
+ !
+ DO JLL=1,3
+ Z_VALUE_GHOS(JLL) = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_TEMP(:,JLL),Y_MODE_INTE1(JLL))
+ IF (Y_MODE_BOUND(JLL)=='SYM') Z_VALUE_GHOS(JLL) = +Z_VALUE_GHOS(JLL)
+ IF (Y_MODE_BOUND(JLL)=='ASY') Z_VALUE_GHOS(JLL) = -Z_VALUE_GHOS(JLL) + 2.*Z_VALUE_TEMP(4,JLL)
+ IF (Y_MODE_BOUND(JLL)=='CST') Z_VALUE_GHOS(JLL) = Z_VALUE_TEMP(4,JLL)
+ ENDDO
+ !
+ PVAR(JI,JJ,JK) = Z_VALUE_MAT2(JH,1)*Z_VALUE_GHOS(1) +&
+ Z_VALUE_MAT2(JH,2)*Z_VALUE_GHOS(2) +&
+ Z_VALUE_MAT2(JH,3)*Z_VALUE_GHOS(3)
+ !
+ IF ((JH==3).AND.(JK==2)) THEN
+ PVAR(JI,JJ,JK) = 0.
+ ENDIF
+ !
+777 CONTINUE
+ !
+ ENDDO
+ ENDDO
+ !
+666 CONTINUE
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDEX_CORN)
+ DEALLOCATE(Z_LOCAT_CORN)
+ DEALLOCATE(Z_VALUE_CORN)
+ DEALLOCATE(Z_LOCAT_IMAG)
+ DEALLOCATE(Z_VALUE_IMAG)
+ DEALLOCATE(Z_VALUE_TEMP)
+ DEALLOCATE(Z_LOCAT_BOUN)
+ DEALLOCATE(Z_LOCAT_GHOS)
+ DEALLOCATE(Z_VALUE_GHOS)
+ DEALLOCATE(Z_TESTS_CORN)
+ DEALLOCATE(Y_TYPE_BOUND,Y_FORC_BOUND)
+ DEALLOCATE(Y_MODE_BOUND,Y_MODE_INTE1)
+ DEALLOCATE(Z_FORC_BOUND)
+ DEALLOCATE(Z_VALUE_MAT1)
+ DEALLOCATE(Z_VALUE_MAT2)
+ DEALLOCATE(Z_VALUE_ZLKE)
+ DEALLOCATE(Z_TEMP_ZLKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_AFFECTV
diff --git a/src/MNH/ibm_balance.f90 b/src/MNH/ibm_balance.f90
new file mode 100644
index 0000000000000000000000000000000000000000..80e1ed14a913ed943148f1ba1b452c78f1cfc81e
--- /dev/null
+++ b/src/MNH/ibm_balance.f90
@@ -0,0 +1,552 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_BALANCE
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_BALANCE(PPHI,PVOL,PRUS,PRVS,PRWS,PBAL)
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVOL
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PBAL
+ !
+ END SUBROUTINE IBM_BALANCE
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_BALANCE
+!
+! #####################################################
+SUBROUTINE IBM_BALANCE(PPHI,PVOL,PRUS,PRVS,PRWS,PBAL)
+ ! #####################################################
+ !
+ !
+ !**** IBM_BALANCE computes the velocity divergence using a volumic approach
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to compute div(U)=1/V*int_S(u.n)dS
+ ! S is the modified surface and is estimated before MNH
+ ! U is approximated using adjacents points
+
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_CST, ONLY: XPI
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_LBC_n
+ USE MODD_REF_n
+ !
+ ! interface
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVOL
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PBAL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: IIE,IIB,IJE,IJB,IKE,IKB
+ INTEGER :: JI,JJ,JK,JL,JI2,JJ2,JK2,JM
+ REAL :: ZPH0,ZPH1,ZPH2,ZDEL,ZBAR,ZRAY,ZCOE,ZCO2
+ REAL :: ZVIT1,ZVIT2,ZVIT0,ZSIG0,ZSIG1,ZSIG2
+ REAL, DIMENSION(:,:,:,:) ,ALLOCATABLE :: ZIBM_FLUX
+ REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZFLU
+ REAL :: ZTOTO
+ REAL :: ZINVROOTPI
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU = SIZE(PPHI,3)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ ALLOCATE(ZIBM_FLUX(IIU,IJU,IKU,3))
+ ALLOCATE(ZFLU(IIU,IJU,IKU))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZIBM_FLUX = 0.
+ ZFLU = 0.
+ ZTOTO = 1.0
+ ZINVROOTPI = 1.0/SQRT(XPI)
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ !
+ IF (PVOL(JI,JJ,JK,3).gt.XIBM_EPSI) THEN
+ !
+ ! Flux, west
+ JL = 2
+ JI2 = JI
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = 0.
+ ZDEL = SQRT((XYHAT(JJ+1)-XYHAT(JJ))*0.5*(XZZ(JI2,JJ,JK+1)-XZZ(JI2,JJ,JK)+XZZ(JI2-1,JJ,JK+1)-XZZ(JI2-1,JJ,JK)))
+ ZPH1 = PPHI(JI2 ,JJ ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRUS(JI2,JJ ,JK )
+ !
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRUS(JI2,JJ2,JK2)
+ ZRAY = ZDEL*ZINVROOTPI*ZTOTO
+ ZBAR = 0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR=-ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ !
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = ZIBM_FLUX(JI2,JJ,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ ENDDO
+ !
+ ! Flux, East
+ JL = 2
+ JI2 = JI+1
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = 0.
+ ZDEL = SQRT((XYHAT(JJ+1)-XYHAT(JJ))*0.5*(XZZ(JI2,JJ,JK+1)-XZZ(JI2,JJ,JK)+XZZ(JI2-1,JJ,JK+1)-XZZ(JI2-1,JJ,JK)))
+ ZPH1 = PPHI(JI2 ,JJ ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRUS(JI2,JJ ,JK )
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRUS(JI2,JJ2,JK2)
+ ZRAY = ZDEL*ZINVROOTPI*ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR=-ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = ZIBM_FLUX(JI2,JJ,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, south
+ JL = 3
+ JJ2 = JJ
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*0.5*(XZZ(JI,JJ2,JK+1)-XZZ(JI,JJ2,JK)+XZZ(JI,JJ2-1,JK+1)-XZZ(JI,JJ2-1,JK)))
+ ZPH1 = PPHI(JI ,JJ2 ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRVS(JI ,JJ2,JK )
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JI2 = JI-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JI2 = JI-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JI2 = JI-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JI2 = JI+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JI2 = JI+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JI2 = JI+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JI2 = JI
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JI2 = JI
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRVS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = ZIBM_FLUX(JI,JJ2,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ ENDDO
+ !
+ ! Flux, north
+ JL = 3
+ JJ2 = JJ+1
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*0.5*(XZZ(JI,JJ2,JK+1)-XZZ(JI,JJ2,JK)+XZZ(JI,JJ2-1,JK+1)-XZZ(JI,JJ2-1,JK)))
+ ZPH1 = PPHI(JI ,JJ2 ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRVS(JI ,JJ2,JK )
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JI2 = JI-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JI2 = JI-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JI2 = JI-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JI2 = JI+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JI2 = JI+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JI2 = JI+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JI2 = JI
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JI2 = JI
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRVS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = ZIBM_FLUX(JI,JJ2,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, bottom
+ JL = 4
+ JK2 = JK
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))
+ ZPH1 = PPHI(JI ,JJ ,JK2 ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRWS(JI ,JJ ,JK2)
+ !
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JI2 = JI-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JI2 = JI+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRWS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = ZIBM_FLUX(JI,JJ,JK2,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, top
+ JL = 4
+ JK2 = JK+1
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))
+ ZPH1 = PPHI(JI ,JJ ,JK2 ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRWS(JI ,JJ ,JK2)
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JI2 = JI-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JI2 = JI+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRWS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = ZIBM_FLUX(JI,JJ,JK2,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ZFLU(IIB:IIE,IJB:IJE,IKB:IKE) = (ZIBM_FLUX(IIB+1:IIE+1,IJB :IJE ,IKB :IKE ,1)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,1) +&
+ ZIBM_FLUX(IIB :IIE ,IJB+1:IJE+1,IKB :IKE ,2)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,2) +&
+ ZIBM_FLUX(IIB :IIE ,IJB :IJE ,IKB+1:IKE+1,3)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,3))*&
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)/XRHODJ(IIB:IIE,IJB:IJE,IKB:IKE)
+ !
+ PBAL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1) = PBAL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1)* &
+ PVOL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1,2)+ZFLU(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1)* &
+ PVOL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1,3)
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ DEALLOCATE(ZIBM_FLUX,ZFLU)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_BALANCE
diff --git a/src/MNH/ibm_detect.f90 b/src/MNH/ibm_detect.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6b80f7598c5046edc75eca376b1367a1a270d587
--- /dev/null
+++ b/src/MNH/ibm_detect.f90
@@ -0,0 +1,967 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! ######################
+MODULE MODI_IBM_DETECT
+ ! ######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_DETECT(PPHI)
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ !
+ END SUBROUTINE IBM_DETECT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_DETECT
+!
+! ###########################
+SUBROUTINE IBM_DETECT(PPHI)
+ ! ###########################
+ !
+ !
+ !**** IBM_DETECT is dedicated to the characterization of the ghost point and
+ ! associated image points
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to affect an specific index to cells where
+ ! ghost points are localized. Depending on order of numerical scheme the
+ ! thickness of ghost points layer varies as the index value. For each cell
+ ! marked as ghost the corresponding image point location is stored.
+
+ ! METHOD
+ ! ------
+ !**** Iterative procedure to characterize ghost point locations
+ ! - local test on the sign change of the levelset function (first layer)
+ ! - local detection of the first layer to define the neighboring second layer
+ ! - repeat of the previous step for high order numerical scheme
+ !
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_LBC_n
+ USE MODD_CONF, ONLY: NHALO
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GRADIENT_M
+ USE MODI_GRADIENT_U
+ USE MODI_GRADIENT_V
+ USE MODI_GRADIENT_W
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_INTERPOS
+ USE MODI_GRADIENT_UV
+ USE MODI_GRADIENT_VW
+ USE MODI_GRADIENT_UW
+ USE MODI_GDIV
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPHI ! LevelSet functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIB,IJB,IKB,IIE,IJE,IKE ! physical domain size
+ INTEGER :: IIU,IJU,IKU,IIUM,IJUM,IKUM,JN1,JN2 ! numerical domain size
+ INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,JL,JM,JN,JMM,JNN,JP ! loop index
+ INTEGER :: JIM1,JIP1,JJM1,JJP1,JKM1,JKP1,JI3,JJ3,JK3 ! loop boundaries
+ INTEGER :: JIM2,JIP2,JJM2,JJP2,JKM2,JKP2
+ INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: I_INDE_GHOST ! ghosts index storage
+ INTEGER :: I_DIME_GHOST,I_INDE_LOCAT
+ INTEGER, DIMENSION(:,:) , ALLOCATABLE :: I_NUMB_GHOST
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDE_TEMPO,I_INDE_TEMPO2
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll,I_NUMB_LAYER
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: ZXPOS,ZYPOS,ZZPOS,Z_NORM_TEMP1 ! staggered grid arrays
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: Z_NORM_TEMP2,Z_NORM_TEMP3
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: Z_NORM_GHOST ! vec(n)
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: Z_NORM_TEMPO,ZIBM_TESTING,ZPHI
+ REAL :: ZLGHO
+ REAL, DIMENSION(:) , ALLOCATABLE :: ZVECT,ZPROD,Z_PHI
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMG,Z_GHO
+ INTEGER :: I_NUMB_LAYERV,I_NUMB_LAYERP,I_DIME_GHOSTV,I_DIME_GHOSTP
+ REAL :: ZSEAR,ZISI,ZJSI,ZKSI,ZLIMG
+ REAL :: ZIBM_TESTI,PPHI_CORR,PPHI_TEST
+ INTEGER :: JHALO,IKM,JLL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU=SIZE(PPHI,1)
+ IJU=SIZE(PPHI,2)
+ IKU=SIZE(PPHI,3)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IKB=1 +JPVEXT
+ IKE=IKU-JPVEXT
+ IKM=INT(IKU/2.)
+ !
+ ALLOCATE(I_INDE_GHOST(IIB:IIE,IJB:IJE,IKB:IKE,4))
+ ALLOCATE(ZIBM_TESTING(IIU,IJU,IKU,4))
+ ALLOCATE(Z_PHI(8),ZPROD(6),ZVECT(3),Z_IMG(8,3),Z_GHO(8,3),I_INDE_TEMPO(3),I_INDE_TEMPO2(3))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ JHALO = 0
+ ZVECT(:) = 0.
+ ZPROD(:) = 0.
+ Z_PHI(:) = 0.
+ Z_IMG(:,:) = 0.
+ Z_GHO(:,:) = 0.
+ I_INDE_TEMPO(:) = 0
+ I_INDE_GHOST(:,:,:,:) = 0
+ Z_NORM_GHOST(:,:,:,:) = 0.
+ Z_NORM_TEMPO(:,:,:,:) = 0.
+ ZIBM_TESTING(:,:,:,:) = 0.
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !I_IBM_NUMB_GHOST stores the ghost number per layer and node type
+ I_NUMB_LAYERV = NIBM_LAYER_V
+ I_NUMB_LAYERP = max(NIBM_LAYER_P,NIBM_LAYER_T,NIBM_LAYER_E, &
+ NIBM_LAYER_R,NIBM_LAYER_Q,NIBM_LAYER_S)
+ I_NUMB_LAYER = max(I_NUMB_LAYERV,I_NUMB_LAYERP)
+ !
+ ALLOCATE(I_NUMB_GHOST(4,I_NUMB_LAYER))
+ I_NUMB_GHOST(:,:)=0
+ !
+ ! Ghost cells detection
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ !
+ ! arrays computation
+ IF (JL==1) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==2) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==3) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==4) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ !
+ DO JK = IKB,IKUM
+ !
+ JKM1 = JK-I_NUMB_LAYER
+ JKP1 = JK+I_NUMB_LAYER
+ !
+ IF (JK==IKB ) JKM1 = JK
+ IF (JK==IKUM) JKP1 = JK
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (JK==IKB+1 ) JKM1 = JK-1
+ IF (JK==IKUM-1) JKP1 = JK+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (JK==IKB+2 ) JKM1 = JK-2
+ IF (JK==IKUM-2) JKP1 = JK+2
+ ENDIF
+ JKM1 = max(2 ,JKM1)
+ JKP1 = min(IKU-1,JKP1)
+ !
+ DO JJ = IJB,IJUM
+ !
+ JJM1 = JJ-I_NUMB_LAYER
+ JJP1 = JJ+I_NUMB_LAYER
+ !
+ IF (LSOUTH_ll().and.JJ==IJB) JJM1=JJ
+ IF (LNORTH_ll().and.JJ==IJUM) JJP1=JJ
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (LSOUTH_ll().and.JJ==IJB+1) JJM1=JJ-1
+ IF (LNORTH_ll().and.JJ==IJUM-1) JJP1=JJ+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (LSOUTH_ll().and.JJ==IJB+2) JJM1=JJ-2
+ IF (LNORTH_ll().and.JJ==IJUM-2) JJP1=JJ+2
+ ENDIF
+ JJM1 = max(1 ,JJM1)
+ JJP1 = min(IJU,JJP1)
+ !
+ DO JI = IIB,IIUM
+ !
+ JIM1 = JI-I_NUMB_LAYER
+ JIP1 = JI+I_NUMB_LAYER
+ !
+ IF (LWEST_ll().and.JI==IIB) JIM1=JI
+ IF (LEAST_ll().and.JI==IIUM) JIP1=JI
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (LWEST_ll().and.JI==IIB+1) JIM1=JI-1
+ IF (LEAST_ll().and.JI==IIUM-1) JIP1=JI+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (LWEST_ll().and.JI==IIB+2) JIM1=JI-2
+ IF (LEAST_ll().and.JI==IIUM-2) JIP1=JI+2
+ ENDIF
+ JIM1 = max(1 ,JIM1)
+ JIP1 = min(IIU,JIP1)
+ !
+ ! test for embedded solid region
+ IF (PPHI(JI,JJ,JK,JL).gt.-XIBM_EPSI) THEN
+ !
+ DO JM=1,3
+
+ IF (JM==1) THEN
+ JIM2 = JI
+ JIP2 = JI
+ JJM2 = JJ
+ JJP2 = JJ
+ JKM2 = JKM1
+ JKP2 = JKP1
+ ENDIF
+ IF (JM==2) THEN
+ JIM2 = JIM1
+ JIP2 = JIP1
+ JJM2 = JJ
+ JJP2 = JJ
+ JKM2 = JK
+ JKP2 = JK
+ ENDIF
+ IF (JM==3) THEN
+ JIM2 = JI
+ JIP2 = JI
+ JJM2 = JJM1
+ JJP2 = JJP1
+ JKM2 = JK
+ JKP2 = JK
+ ENDIF
+ !
+ DO JK2= JKM2,JKP2
+ DO JJ2= JJM2,JJP2
+ DO JI2= JIM2,JIP2
+ !
+ ! interface presence test (multi layer)
+ IF ((PPHI(JI,JJ,JK,JL)*PPHI(JI2,JJ2,JK2,JL)).lt.-XIBM_EPSI) THEN
+ I_INDE_LOCAT = max(abs(JI-JI2),abs(JJ-JJ2),abs(JK-JK2))
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)/=0) THEN
+ I_INDE_GHOST(JI,JJ,JK,JL) = min(I_INDE_GHOST(JI,JJ,JK,JL),I_INDE_LOCAT)
+ ZIBM_TESTING(JI,JJ,JK,JL)=I_INDE_GHOST(JI,JJ,JK,JL)*1.
+ ELSE
+ I_INDE_GHOST(JI,JJ,JK,JL) = I_INDE_LOCAT
+ ZIBM_TESTING(JI,JJ,JK,JL)=I_INDE_GHOST(JI,JJ,JK,JL)*1.
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ ! ghosts counter
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)>0) THEN
+ I_NUMB_GHOST(JL,I_INDE_GHOST(JI,JJ,JK,JL))=I_NUMB_GHOST(JL,I_INDE_GHOST(JI,JJ,JK,JL))+1
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ I_DIME_GHOSTV = 0
+ DO JL=1,I_NUMB_LAYERV
+ I_DIME_GHOSTV = max(I_DIME_GHOSTV,I_NUMB_GHOST(2,JL),I_NUMB_GHOST(3,JL),I_NUMB_GHOST(4,JL))
+ ENDDO
+ I_DIME_GHOSTP = 0
+ DO JL=1,I_NUMB_LAYERP
+ I_DIME_GHOSTP = max(I_DIME_GHOSTP,I_NUMB_GHOST(1,JL))
+ ENDDO
+ !
+ ! === GHOSTS storage ===
+ ! NIBM_STOR_GHOSV(A,B,C)
+ ! A : number of ghosts for each type of nodes
+ ! B : type of ghosts layer
+ ! C : type of ghosts PUVW
+ ! D : index location IJK
+ ALLOCATE(NIBM_GHOST_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3))
+ NIBM_GHOST_V(:,:,:,:) = 0
+ !
+ ! NIBM_STOR_GHOSP(A,B,C)
+ ! A : number of ghosts for each type of nodes P
+ ! B : type of ghosts layer
+ ! C : ---
+ ! D : index location IJK
+ ALLOCATE(NIBM_GHOST_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3))
+ NIBM_GHOST_P(:,:,:,:) = 0
+ !
+ ! XIBM_STOR_GHOSV(A,B,C,D)
+ ! A : number of ghosts in each type of nodes PUVW
+ ! B : layer number
+ ! C : type of nodes UVW for the image(s)
+ ! D : location of the ghost
+ ALLOCATE(XIBM_GHOST_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3))
+ XIBM_GHOST_V(:,:,:,:) = 0.
+ !
+ ! XIBM_STOR_GHOSP(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : location of the ghost
+ ALLOCATE(XIBM_GHOST_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3))
+ XIBM_GHOST_P(:,:,:,:) = 0.
+ !
+ ! Reset ghost research
+ I_NUMB_GHOST(:,:) = 0
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ !
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ !
+ DO JM = 1,I_NUMB_LAYER
+ DO JK = IKB,IKUM
+ DO JJ = IJB,IJUM
+ DO JI = IIB,IIUM
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)==JM) THEN
+ I_NUMB_GHOST(JL,JM) = I_NUMB_GHOST(JL,JM) + 1
+ IF (JL==1) THEN
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,1) = JI
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,2) = JJ
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,3) = JK
+ ELSE
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,1) = JI
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,2) = JJ
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,3) = JK
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ !=== IMAGES cells detection ===
+ !
+ ! NIBM_TEST_IMAGV(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes UVW
+ ! B : layer number
+ ! C : UVW node type for ghost
+ ! D : UVW node type for image
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : corner index
+ ALLOCATE(XIBM_TESTI_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3,8))
+ XIBM_TESTI_V = 1.
+ !
+ ! NIBM_TEST_IMAGP(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : ---
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : corner index
+ ALLOCATE(XIBM_TESTI_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,1,3,8))
+ XIBM_TESTI_P = 1.
+ !
+ ! NIBM_STOR_IMAGV(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes UVW
+ ! B : layer number
+ ! C : UVW node type for ghost
+ ! D : UVW node type for image
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : index of the image(s)
+ ALLOCATE(NIBM_IMAGE_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3,3))
+ NIBM_IMAGE_V(:,:,:,:,:,:) = 0
+ !
+ ! NIBM_STOR_IMAGP(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : ---
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : index of the image(s)
+ ALLOCATE(NIBM_IMAGE_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,1,3,3))
+ NIBM_IMAGE_P(:,:,:,:,:,:) = 0
+ !
+ ! XIBM_STOR_IMAGV(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes PUVW
+ ! B : layer number
+ ! C : type of nodes UVW for the image(s)
+ ! D : 1 for IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! E : location of the image(s)
+ ALLOCATE(XIBM_IMAGE_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3))
+ XIBM_IMAGE_V(:,:,:,:,:) = 0.
+ !
+ ! XIBM_STOR_IMAGP(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : 1 for IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! E : location of the image(s)
+ ALLOCATE(XIBM_IMAGE_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3,3))
+ XIBM_IMAGE_P(:,:,:,:,:) = 0.
+ !
+ ALLOCATE(Z_NORM_GHOST(IIU,IJU,IKU,3),Z_NORM_TEMPO(IIU,IJU,IKU,3),Z_NORM_TEMP1(IIU,IJU,IKU,4),Z_NORM_TEMP2(IIU,IJU,IKU), &
+ Z_NORM_TEMP3(IIU,IJU,IKU))
+ ALLOCATE(ZPHI(IIU,IJU,IKU,4))
+ ZPHI = 0.
+ !
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ IF (I_NUMB_LAYER==0) GO TO 667
+ !
+ ! div(n) computation
+ IF (JL==1) THEN
+ Z_NORM_TEMPO(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMPO(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMPO(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMP1(:,:,:,1) = - GX_M_U(1,IKU,1,PPHI(:,:,:,1),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_M_V(1,IKU,1,PPHI(:,:,:,1),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_M_W(1,IKU,1,PPHI(:,:,:,1),XDZZ)
+ CALL GDIV(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ,Z_NORM_TEMP1(:,:,:,1),Z_NORM_TEMP1(:,:,:,2),Z_NORM_TEMP1(:,:,:,3), &
+ XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=-XIBM_CURV(:,:,:)*(XRHODJ(:,:,:)/XRHODREF(:,:,:))**(2./3.)
+ IF (LWEST_ll ()) XIBM_CURV(1,:,:) = XIBM_CURV(2 ,:,:)
+ IF (LEAST_ll ()) XIBM_CURV(IIU,:,:) = XIBM_CURV(IIU-1,:,:)
+ IF (LSOUTH_ll()) XIBM_CURV(:,1,:) = XIBM_CURV(:,2 ,:)
+ IF (LNORTH_ll()) XIBM_CURV(:,IJU,:) = XIBM_CURV(:,IJU-1,:)
+ XIBM_CURV(:,:,1 ) = XIBM_CURV(:,:, 2)
+ XIBM_CURV(:,:,IKU) = XIBM_CURV(:,:,IKU-1)
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_CURV(:,:,:),'IBM_DETECT::XIBM_CURV')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ XIBM_SU(:,:,:,1)=MXM(XIBM_CURV(:,:,:))
+ XIBM_SU(:,:,:,2)=MYM(XIBM_CURV(:,:,:))
+ XIBM_SU(:,:,:,3)=MZM(XIBM_CURV(:,:,:))
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,1) = XIBM_SU(2 ,:,:,1)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,1) = XIBM_SU(IIU-1,:,:,1)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,1) = XIBM_SU(:,2 ,:,1)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,1) = XIBM_SU(:,IJU-1,:,1)
+ XIBM_SU(:,:,1 ,1) = XIBM_SU(:,:, 2,1)
+ XIBM_SU(:,:,IKU,1) = XIBM_SU(:,:,IKU-1,1)
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,2) = XIBM_SU(2 ,:,:,2)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,2) = XIBM_SU(IIU-1,:,:,2)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,2) = XIBM_SU(:,2 ,:,2)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,2) = XIBM_SU(:,IJU-1,:,2)
+ XIBM_SU(:,:,1 ,2) = XIBM_SU(:,:, 2,2)
+ XIBM_SU(:,:,IKU,2) = XIBM_SU(:,:,IKU-1,2)
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,3) = XIBM_SU(2 ,:,:,3)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,3) = XIBM_SU(IIU-1,:,:,3)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,3) = XIBM_SU(:,2 ,:,3)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,3) = XIBM_SU(:,IJU-1,:,3)
+ XIBM_SU(:,:,1 ,3) = XIBM_SU(:,:, 2,3)
+ XIBM_SU(:,:,IKU,3) = XIBM_SU(:,:,IKU-1,3)
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,1),'IBM_DETECT::XIBM_SU')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,2),'IBM_DETECT::XIBM_SU')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,3),'IBM_DETECT::XIBM_SU')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ XIBM_CURV(:,:,:)=0.5*XIBM_CURV(:,:,:)+0.5/3.*(MXF(XIBM_SU(:,:,:,1))+ &
+ MYF(XIBM_SU(:,:,:,2))+ &
+ MZF(XIBM_SU(:,:,:,3)))
+ !
+ IF (LWEST_ll ()) XIBM_CURV(1,:,:) = XIBM_CURV(2 ,:,:)
+ IF (LEAST_ll ()) XIBM_CURV(IIU,:,:) = XIBM_CURV(IIU-1,:,:)
+ IF (LSOUTH_ll()) XIBM_CURV(:,1,:) = XIBM_CURV(:,2 ,:)
+ IF (LNORTH_ll()) XIBM_CURV(:,IJU,:) = XIBM_CURV(:,IJU-1,:)
+ XIBM_CURV(:,:,1 ) = XIBM_CURV(:,:, 2)
+ XIBM_CURV(:,:,IKU) = XIBM_CURV(:,:,IKU-1)
+ !
+ XIBM_CURV(:,:,:)=1./(ABS(XIBM_CURV(:,:,:))+XIBM_EPSI)
+ XIBM_CURV(:,:,:)=MIN(1., XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=MAX(0., XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=1.-XIBM_CURV(:,:,:)
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_CURV(:,:,:),'IBM_DETECT::XIBM_CURV')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ENDIF
+ !
+ IF (JL==2) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MXM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MXM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MXM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ IF (JL==3) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MYM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MYM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MYM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ IF (JL==4) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MZM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MZM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MZM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ !
+ Z_NORM_TEMPO(:,:,1 ,1) = +Z_NORM_TEMPO(:,:, 2,1)
+ Z_NORM_TEMPO(:,:,IKU,1) = +Z_NORM_TEMPO(:,:,IKU-1,1)
+ Z_NORM_TEMPO(:,:,1 ,2) = +Z_NORM_TEMPO(:,:, 2,2)
+ Z_NORM_TEMPO(:,:,IKU,2) = +Z_NORM_TEMPO(:,:,IKU-1,2)
+ Z_NORM_TEMPO(:,:,1 ,3) = 2*Z_NORM_TEMPO(:,:, 2,3)-Z_NORM_TEMPO(:,:, 3,3)
+ Z_NORM_TEMPO(:,:,IKU,3) = 2*Z_NORM_TEMPO(:,:,IKU-1,3)-Z_NORM_TEMPO(:,:,IKU-2,3)
+ Z_NORM_TEMPO(:,:,1 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,1 ,3))
+ Z_NORM_TEMPO(:,:,2 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,2 ,3))
+ Z_NORM_TEMPO(:,:,3 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,3 ,3))
+ Z_NORM_TEMPO(:,:,IKU ,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU ,3))
+ Z_NORM_TEMPO(:,:,IKU-1,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU-1,3))
+ Z_NORM_TEMPO(:,:,IKU-2,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU-2,3))
+ !
+ IF (LWEST_ll ()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,1),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,2),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,3),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ Z_NORM_TEMP2(:,:,:) = sqrt(Z_NORM_TEMPO(:,:,:,1)**2.+Z_NORM_TEMPO(:,:,:,2)**2.+Z_NORM_TEMPO(:,:,:,3)**2.)
+ !
+ WHERE (abs(Z_NORM_TEMP2(:,:,:)) .gt. XIBM_EPSI)
+ Z_NORM_GHOST(:,:,:,1) = Z_NORM_TEMPO(:,:,:,1)/Z_NORM_TEMP2(:,:,:)
+ Z_NORM_GHOST(:,:,:,2) = Z_NORM_TEMPO(:,:,:,2)/Z_NORM_TEMP2(:,:,:)
+ Z_NORM_GHOST(:,:,:,3) = Z_NORM_TEMPO(:,:,:,3)/Z_NORM_TEMP2(:,:,:)
+ ELSEWHERE
+ Z_NORM_GHOST(:,:,:,1) = 0.
+ Z_NORM_GHOST(:,:,:,2) = 0.
+ Z_NORM_GHOST(:,:,:,3) = 1.
+ ENDWHERE
+ !
+ WHERE (abs(Z_NORM_TEMP2(:,:,:)) .gt. XIBM_EPSI)
+ Z_NORM_TEMPO(:,:,:,1) = 1./Z_NORM_TEMP2(:,:,:)
+ Z_NORM_TEMPO(:,:,:,2) = 1./Z_NORM_TEMP2(:,:,:)
+ Z_NORM_TEMPO(:,:,:,3) = 1./Z_NORM_TEMP2(:,:,:)
+ ELSEWHERE
+ Z_NORM_TEMPO(:,:,:,1) = 1.
+ Z_NORM_TEMPO(:,:,:,2) = 1.
+ Z_NORM_TEMPO(:,:,:,3) = 1.
+ ENDWHERE
+ !
+ DO JMM = 1, I_NUMB_LAYER
+ !
+ DO JM = 1, I_NUMB_GHOST(JL,JMM)
+ !
+ ! ghost index
+ IF (JL==1) THEN
+ I_INDE_TEMPO(:) = NIBM_GHOST_P(JM,JMM,JL ,:)
+ ELSE
+ I_INDE_TEMPO(:) = NIBM_GHOST_V(JM,JMM,JL-1,:)
+ ENDIF
+ JI2 = I_INDE_TEMPO(1)
+ JJ2 = I_INDE_TEMPO(2)
+ JK2 = I_INDE_TEMPO(3)
+ !
+ ! ghost location
+ Z_GHO(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JL)
+ ZLGHO = (abs(Z_GHO(1,1)-Z_GHO(8,1))* &
+ abs(Z_GHO(1,2)-Z_GHO(8,2))* &
+ abs(Z_GHO(1,3)-Z_GHO(8,3)))**(1./3.)
+ ZVECT(1) = Z_GHO(1,1)
+ ZVECT(2) = Z_GHO(1,2)
+ ZVECT(3) = Z_GHO(1,3)
+ !
+ PPHI_TEST = ABS(Z_NORM_GHOST(JI2,JJ2,JK2,1))+ABS(Z_NORM_GHOST(JI2,JJ2,JK2,2))+ABS(Z_NORM_GHOST(JI2,JJ2,JK2,3))
+ PPHI_CORR = MAX(PPHI(JI2,JJ2,JK2,JL),(JMM*1.-1.)*ZLGHO*PPHI_TEST)
+ PPHI_CORR = MIN(PPHI_CORR ,(JMM*1.+0.)*ZLGHO*PPHI_TEST)
+ !
+ ! Storage of mirror/image1/image2/mirror locations
+ IF (JL==1) THEN
+ XIBM_IMAGE_P(JM,JMM,JL ,1,:) = (1.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,2,:) = (2.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,3,:) = (0.5*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_GHOST_P(JM,JMM,JL ,:) = ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,1,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,1,3))
+ XIBM_IMAGE_P(JM,JMM,JL ,2,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,2,3))
+ XIBM_IMAGE_P(JM,JMM,JL ,3,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,3,3))
+ XIBM_GHOST_P(JM,JMM,JL ,3) = MAX(XIBM_EPSI,XIBM_GHOST_P(JM,JMM,JL ,3))
+ ELSE
+ XIBM_IMAGE_V(JM,JMM,JL-1,1,:) = (1.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,2,:) = (2.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,3,:) = (0.5*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_GHOST_V(JM,JMM,JL-1 ,:) = ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,1,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,1,3))
+ XIBM_IMAGE_V(JM,JMM,JL-1,2,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,2,3))
+ XIBM_IMAGE_V(JM,JMM,JL-1,3,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,3,3))
+ XIBM_GHOST_V(JM,JMM,JL-1 ,3) = MAX(XIBM_EPSI,XIBM_GHOST_V(JM,JMM,JL-1 ,3))
+ ENDIF
+ !
+ ! iterative procedure to find image cell
+ ZISI = 0.
+ ZJSI = 0.
+ ZKSI = 0.
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,1)).gt.XIBM_EPSI) THEN
+ ZISI =Z_NORM_GHOST(JI2,JJ2,JK2,1)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,1))
+ ENDIF
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,2)).gt.XIBM_EPSI) THEN
+ ZJSI =Z_NORM_GHOST(JI2,JJ2,JK2,2)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,2))
+ ENDIF
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,3)).gt.XIBM_EPSI) THEN
+ ZKSI =Z_NORM_GHOST(JI2,JJ2,JK2,3)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,3))
+ ENDIF
+ JIM1 = 3-2*JMM*int(min(0.,ZISI))
+ JIP1 = 3+2*JMM*int(max(0.,ZISI))
+ JJM1 = 3-2*JMM*int(min(0.,ZJSI))
+ JJP1 = 3+2*JMM*int(max(0.,ZJSI))
+ JKM1 = 3-2*JMM*int(min(0.,ZKSI))
+ JKP1 = 3+2*JMM*int(max(0.,ZKSI))
+ JIM2=max(1 ,JI2-JIM1)
+ JIP2=min(IIU-1,JI2+JIP1)
+ JJM2=max(1 ,JJ2-JJM1)
+ JJP2=min(IJU-1,JJ2+JJP1)
+ JKM2=max(1 ,JK2-JKM1)
+ JKP2=min(IKU-1,JK2+JKP1)
+ !
+ JN1 = 1
+ JN2 = 1
+ IF (JL/=1) THEN
+ JN1 = 2
+ JN2 = 4
+ ENDIF
+ !
+ DO JNN=1,3
+ !
+ ! image1/image2/mirror location
+ IF (JL==1) THEN
+ ZVECT(:) = XIBM_IMAGE_P(JM,JMM,JL ,JNN,:)
+ ELSE
+ ZVECT(:) = XIBM_IMAGE_V(JM,JMM,JL-1,JNN,:)
+ ENDIF
+ !
+ DO JN =JN1,JN2
+ !
+ ! search image depending on location type
+ ZSEAR = 0.
+ DO JK= JKM2,JKP2
+ DO JJ= JJM2,JJP2
+ DO JI= JIM2,JIP2
+ !
+ ! nodes of the potential image cell
+ I_INDE_TEMPO(1) = JI
+ I_INDE_TEMPO(2) = JJ
+ I_INDE_TEMPO(3) = JK
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ !
+ ! location of the potential cell
+ ZPROD(1) = min(Z_IMG(1,1),Z_IMG(2,1),Z_IMG(3,1),Z_IMG(4,1),&
+ Z_IMG(5,1),Z_IMG(6,1),Z_IMG(7,1),Z_IMG(8,1))
+ ZPROD(2) = max(Z_IMG(1,1),Z_IMG(2,1),Z_IMG(3,1),Z_IMG(4,1),&
+ Z_IMG(5,1),Z_IMG(6,1),Z_IMG(7,1),Z_IMG(8,1))
+ ZPROD(3) = min(Z_IMG(1,2),Z_IMG(2,2),Z_IMG(3,2),Z_IMG(4,2),&
+ Z_IMG(5,2),Z_IMG(6,2),Z_IMG(7,2),Z_IMG(8,2))
+ ZPROD(4) = max(Z_IMG(1,2),Z_IMG(2,2),Z_IMG(3,2),Z_IMG(4,2),&
+ Z_IMG(5,2),Z_IMG(6,2),Z_IMG(7,2),Z_IMG(8,2))
+ ZPROD(5) = min(Z_IMG(1,3),Z_IMG(2,3),Z_IMG(3,3),Z_IMG(4,3),&
+ Z_IMG(5,3),Z_IMG(6,3),Z_IMG(7,3),Z_IMG(8,3))
+ ZPROD(6) = max(Z_IMG(1,3),Z_IMG(2,3),Z_IMG(3,3),Z_IMG(4,3),&
+ Z_IMG(5,3),Z_IMG(6,3),Z_IMG(7,3),Z_IMG(8,3))
+ !
+ IF (((ZVECT(1).gt.(ZPROD(1)-XIBM_EPSI)).and.(ZVECT(1).lt.(ZPROD(2)+XIBM_EPSI))).and.&
+ ((ZVECT(2).gt.(ZPROD(3)-XIBM_EPSI)).and.(ZVECT(2).lt.(ZPROD(4)+XIBM_EPSI))).and.&
+ ((ZVECT(3).gt.(ZPROD(5)-XIBM_EPSI)).and.(ZVECT(3).lt.(ZPROD(6)+XIBM_EPSI)))) THEN
+ !
+ JI3=JI
+ JJ3=JJ
+ JK3=JK
+ !
+ IF (JL==1) THEN
+ ZSEAR = 0.5
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,1) = JI3
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,2) = JJ3
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,3) = MAX(JK3,IKB)
+ I_INDE_TEMPO2(1)= JI3
+ I_INDE_TEMPO2(2)= JJ3
+ I_INDE_TEMPO2(3)= JK3
+ Z_PHI(:) = IBM_VALUECORN(PPHI(:,:,:,JN),I_INDE_TEMPO2)
+ IF (JMM==1) ZIBM_TESTI = 0.
+ IF (JMM/=1) ZIBM_TESTI = 1.
+ DO JP=1,8
+ IF (Z_PHI(JP).gt.-XIBM_EPSI) THEN
+ XIBM_TESTI_P(JM,JMM,JL ,JN ,JNN,JP)=0.
+ ELSE
+ XIBM_TESTI_P(JM,JMM,JL ,JN ,JNN,JP)=1.
+ ENDIF
+ ZIBM_TESTI = ZIBM_TESTI+XIBM_TESTI_P(JM,JMM,JL ,JN,JNN,JP)
+ ENDDO
+ IF (ZIBM_TESTI.gt.+XIBM_EPSI) THEN
+ IF (LIBM_TROUBLE) XIBM_SUTR(JI2,JJ2,JK2,JL)=0.
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3<=IIB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIB))
+ ENDIF
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3>=IIE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIE))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3<=IJB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJB))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3>=IJE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJE))
+ ENDIF
+ ZSEAR = 1.
+ ENDIF
+ GO TO 666
+ ELSE
+ ZSEAR = 0.5
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,1) = JI3
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,2) = JJ3
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,3) = MAX(JK3,IKB)
+ I_INDE_TEMPO2(1)= JI3
+ I_INDE_TEMPO2(2)= JJ3
+ I_INDE_TEMPO2(3)= JK3
+ Z_PHI(:) = IBM_VALUECORN(PPHI(:,:,:,JN),I_INDE_TEMPO2)
+ IF (JMM==1) ZIBM_TESTI = 0.
+ IF (JMM/=1) ZIBM_TESTI = 1.
+ DO JP=1,8
+ IF (Z_PHI(JP).gt.-XIBM_EPSI) THEN
+ XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)=0.
+ ELSE
+ XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)=1.
+ ENDIF
+ ZIBM_TESTI = ZIBM_TESTI+XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)
+ ENDDO
+ IF (ZIBM_TESTI.gt.+XIBM_EPSI) THEN
+ IF (LIBM_TROUBLE) XIBM_SUTR(JI2,JJ2,JK2,JL)=0.
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3<=IIB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIB))
+ ENDIF
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3>=IIE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIE))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3<=IJB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJB))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3>=IJE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJE))
+ ENDIF
+ ZSEAR = 1.
+ ENDIF
+ GO TO 666
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+666 CONTINUE
+ !
+ IF ((ZSEAR.gt.0.25).AND.(ZSEAR.lt.0.75).AND.(JMM==1)) THEN
+ ZPHI(JI2,JJ2,JK2,JL)=1.
+ IF (JL==1) THEN
+ WRITE(*,*)'===== IBM WARNING NEW ======'
+ WRITE(*,*)'Non detected PPP images cell'
+ WRITE(*,*)'ghost',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_P(JM,JMM,JL,1),XIBM_GHOST_P(JM,JMM,JL,2),XIBM_GHOST_P(JM,JMM,JL,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_P(JM,JMM,JL,JNN,1),XIBM_IMAGE_P(JM,JMM,JL,JNN,2),XIBM_IMAGE_P(JM,JMM,JL,JNN,3)
+ ELSE
+ WRITE(*,*)'===== IBM WARNING NEW ======'
+ WRITE(*,*)'Non detected UVW images cell'
+ WRITE(*,*)'ghost:',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_V(JM,JMM,JL-1,1),XIBM_GHOST_V(JM,JMM,JL-1,2),XIBM_GHOST_V(JM,JMM,JL-1,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_V(JM,JMM,JL-1,JNN,1),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,2),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,3)
+ ENDIF
+ I_INDE_TEMPO(1) = JIM2
+ I_INDE_TEMPO(2) = JJM2
+ I_INDE_TEMPO(3) = JKM2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MIN',Z_IMG(1,1),Z_IMG(1,2),Z_IMG(1,3)
+ I_INDE_TEMPO(1) = JIP2
+ I_INDE_TEMPO(2) = JJP2
+ I_INDE_TEMPO(3) = JKP2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MAX',Z_IMG(8,1),Z_IMG(8,2),Z_IMG(8,3)
+ ENDIF
+ !
+ IF ((ZSEAR.lt.0.25).AND.(JMM==1)) THEN
+ ZPHI(JI2,JJ2,JK2,JL)=1.
+ IF (JL==1) THEN
+ WRITE(*,*)'===== IBM WARNING ======'
+ WRITE(*,*)'Non detected PPP images cell'
+ WRITE(*,*)'ghost',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_P(JM,JMM,JL,1),XIBM_GHOST_P(JM,JMM,JL,2),XIBM_GHOST_P(JM,JMM,JL,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_P(JM,JMM,JL,JNN,1),XIBM_IMAGE_P(JM,JMM,JL,JNN,2),XIBM_IMAGE_P(JM,JMM,JL,JNN,3)
+ ELSE
+ WRITE(*,*)'===== IBM WARNING ======'
+ WRITE(*,*)'Non detected UVW images cell'
+ WRITE(*,*)'ghost:',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_V(JM,JMM,JL-1,1),XIBM_GHOST_V(JM,JMM,JL-1,2),XIBM_GHOST_V(JM,JMM,JL-1,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_V(JM,JMM,JL-1,JNN,1),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,2),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,3)
+ ENDIF
+ I_INDE_TEMPO(1) = JIM2
+ I_INDE_TEMPO(2) = JJM2
+ I_INDE_TEMPO(3) = JKM2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MIN',Z_IMG(1,1),Z_IMG(1,2),Z_IMG(1,3)
+ I_INDE_TEMPO(1) = JIP2
+ I_INDE_TEMPO(2) = JJP2
+ I_INDE_TEMPO(3) = JKP2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MAX',Z_IMG(8,1),Z_IMG(8,2),Z_IMG(8,3)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+667 CONTINUE
+ !
+ IF ((NHALO<=JHALO).AND.(JMM==1)) WRITE(*,*)'### WARNING HALO ###',JHALO,IP
+ !
+ ENDDO
+ WRITE(*,*)'### HALO ###',NHALO,JHALO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDE_TEMPO,I_INDE_TEMPO2,I_NUMB_GHOST)
+ DEALLOCATE(Z_NORM_GHOST,Z_NORM_TEMPO,Z_NORM_TEMP1,Z_NORM_TEMP2,Z_NORM_TEMP3)
+ DEALLOCATE(ZVECT,ZPROD,ZPHI)
+ DEALLOCATE(Z_PHI,Z_IMG,Z_GHO)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_DETECT
diff --git a/src/MNH/ibm_forcing.f90 b/src/MNH/ibm_forcing.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4014b9905fff763b4407750b6fec7b3ac677ff23
--- /dev/null
+++ b/src/MNH/ibm_forcing.f90
@@ -0,0 +1,313 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_FORCING
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING
+!
+! ##########################################################
+SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! ##########################################################
+ !
+ !!**** *IBM_FORCING* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_CST
+ USE MODD_FIELD_n
+ USE MODD_REF
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ USE MODD_DYN_n, ONLY: XTSTEP
+ !
+ ! interface
+ USE MODI_IBM_AFFECTV
+ USE MODI_IBM_AFFECTP
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMU,ZTRY
+ INTEGER :: IIU,IJU,IKU,IKB,IKE
+ INTEGER :: JRR,JSV
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRVS,2)
+ IKU = SIZE(PRWS,3)
+ !
+ ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
+ ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
+ !
+ ZTMU=0.
+ ZXMU=0.
+ ZDIV=0.
+ ZTMP=0.
+ ZTRY=0.
+ !
+ IKB = 1 + JPVEXT
+ IKE = IKU - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ IF (NSV>=1) THEN
+ !
+ DO JSV=1,NSV
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PSVS(:,:,:,JSV) = XIBM_EPSI**1.5
+ ENDDO
+ !
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTHS(:,:,:) = XTHVREF(:,:,:)
+ !
+ IF (NRR>=1) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI)
+ PRRS(:,:,:,1) = XRVREF(:,:,:)
+ PTHS(:,:,:) = XTHVREF(:,:,:)/(1.+XRD/XRV*XRVREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ IF (NRR>=2) THEN
+ DO JRR=2,NRR
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PRRS(:,:,:,JRR) = XIBM_EPSI
+ ENDDO
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,2).GT.XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,3).GT.XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,4).GT.XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
+ IF (CTURB/='NONE') WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTKS(:,:,:) = XTKEMIN
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! ======================
+ ! === SCALAR FORCING ===
+ ! ======================
+ !
+ IF (CTURB/='NONE') THEN
+ ZTMP(:,:,:) = PTKS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ ZXMU(:,:,:) = XIBM_XMUT(:,:,:)
+ ZDIV(:,:,:) = XIBM_CURV(:,:,:)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_E,XIBM_RADIUS_E,XIBM_POWERS_E,&
+ CIBM_MODE_INTE1_E,CIBM_MODE_INTE3_E,&
+ CIBM_TYPE_BOUND_E,CIBM_MODE_BOUND_E,&
+ CIBM_FORC_BOUND_E,XIBM_FORC_BOUND_E,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=XTKEMIN
+ PTKS(:,:,:)=MAX(XTKEMIN,ZTMP(:,:,:))
+ ENDIF
+ !
+ ZTMP(:,:,:) = PTHS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_T,XIBM_RADIUS_T,XIBM_POWERS_T,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE3_T,&
+ CIBM_TYPE_BOUND_T,CIBM_MODE_BOUND_T,&
+ CIBM_FORC_BOUND_T,XIBM_FORC_BOUND_T,ZXMU,ZDIV)
+ ZTMP(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PTHS(:,:,:) = MAX(ZTMP(:,:,:),250.)
+ !
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ ZTMP(:,:,:) = PRRS(:,:,:,JRR)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_R,XIBM_RADIUS_R,XIBM_POWERS_R,&
+ CIBM_MODE_INTE1_R,CIBM_MODE_INTE3_R,&
+ CIBM_TYPE_BOUND_R,CIBM_MODE_BOUND_R,&
+ CIBM_FORC_BOUND_R,XIBM_FORC_BOUND_R,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PRRS(:,:,:,JRR) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ ZTMP(:,:,:) = PSVS(:,:,:,JSV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_S,XIBM_RADIUS_S,XIBM_POWERS_S,&
+ CIBM_MODE_INTE1_S,CIBM_MODE_INTE3_S,&
+ CIBM_TYPE_BOUND_S,CIBM_MODE_BOUND_S,&
+ CIBM_FORC_BOUND_S,XIBM_FORC_BOUND_S,ZXMU,ZDIV)
+ ZTMP(:,:,:) = MAX(XIBM_EPSI**1.5,ZTMP(:,:,:))
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PSVS(:,:,:,JSV) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ !=======================
+ ! === VECTOR FORCING ===
+ ! ======================
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ ZTMU(:,:,:,1) = PRUS(:,:,:)
+ ZTMU(:,:,:,2) = PRVS(:,:,:)
+ ZTMU(:,:,:,3) = PRWS(:,:,:)
+ !
+ ZTMP(:,:,:) = PRUS(:,:,:)
+ ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRUS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRVS(:,:,:)
+ ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRVS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRWS(:,:,:)
+ ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRWS(:,:,:) = ZTMP(:,:,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ !**** 3. COMMUNICATIONS
+ ! -----------------
+ !
+ IF (.NOT. LIBM_TROUBLE) THEN
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING::PRWS')
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JRR),'IBM_FORCING::PRRS')
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JSV),'IBM_FORCING::PSVS')
+ ENDDO
+ ENDIF
+ !
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ENDIF
+ !
+ !**** 4. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING
diff --git a/src/MNH/ibm_forcing_adv.f90 b/src/MNH/ibm_forcing_adv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8bb60d142ba5132d78c2f36563b8c5991cd3e097
--- /dev/null
+++ b/src/MNH/ibm_forcing_adv.f90
@@ -0,0 +1,184 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! ###########################
+MODULE MODI_IBM_FORCING_ADV
+ ! ###########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING_ADV(PRUS,PRVS,PRWS)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PRUS,PRVS,PRWS
+ !
+ END SUBROUTINE IBM_FORCING_ADV
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING_ADV
+!
+!
+! ##########################################
+SUBROUTINE IBM_FORCING_ADV(PRUS,PRVS,PRWS)
+ ! ##########################################
+ !
+ !!**** *IBM_FORCING_ADV* - routine to force all desired fields in the RK
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_CST
+ USE MODD_FIELD_n
+ USE MODD_REF
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ USE MODD_DYN_n, ONLY: XTSTEP
+ !
+ ! interface
+ USE MODI_IBM_AFFECTV
+ USE MODI_IBM_AFFECTP
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PRUS,PRVS,PRWS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: ZTMU,ZTRY
+ INTEGER :: IIU,IJU,IKU,IKB,IKE
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRVS,2)
+ IKU = SIZE(PRWS,3)
+ ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
+ ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
+ !
+ ZTMU=0.
+ ZXMU=0.
+ ZDIV=0.
+ ZTMP=0.
+ ZTRY=0.
+ !
+ IKB = 1 + JPVEXT
+ IKE = IKU - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ WHERE (XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ ZTMU(:,:,:,1) = PRUS(:,:,:)/MXM(XRHODREF)
+ ZTMU(:,:,:,2) = PRVS(:,:,:)/MYM(XRHODREF)
+ ZTMU(:,:,:,3) = PRWS(:,:,:)/MZM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRUS(:,:,:)/MXM(XRHODREF)
+ ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRUS(:,:,:) = ZTMP(:,:,:)*MXM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRVS(:,:,:)/MYM(XRHODREF)
+ ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRVS(:,:,:) = ZTMP(:,:,:)*MYM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRWS(:,:,:)/MZM(XRHODREF)
+ ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRWS(:,:,:) = ZTMP(:,:,:)*MZM(XRHODREF)
+ !
+ !**** 3. COMMUNICATIONS
+ ! -----------------
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_ADV::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_ADV::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_ADV::PRWS')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !**** 4. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING_ADV
diff --git a/src/MNH/ibm_forcing_tr.f90 b/src/MNH/ibm_forcing_tr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..25e68b339ced4e6c4be1481e113e64a0f87d7f75
--- /dev/null
+++ b/src/MNH/ibm_forcing_tr.f90
@@ -0,0 +1,409 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! ##########################
+MODULE MODI_IBM_FORCING_TR
+ ! ##########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING_TR
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING_TR
+!
+!
+! #############################################################
+SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! #############################################################
+ !
+ !!**** *IBM_FORCING_TR* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ !
+ ! declaration
+ USE MODD_CST, ONLY: XRD,XRV
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,IIU,IJU,IKU,JL
+ INTEGER :: JIM1,JJM1,JKM1,JIP1,JJP1,JKP1
+ INTEGER :: IIE,IIB,IJE,IJB,IKB,IKE
+ REAL :: ZSUM1,ZSUM2,ZSUM4
+ REAL, DIMENSION(:), ALLOCATABLE :: ZSUM3,ZSUM5
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRUS,2)
+ IKU = SIZE(PRUS,3)
+ IKB = 1 + JPVEXT
+ IKE = SIZE(PRUS,3) - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Problems in GCT ? => imposition of the adjacent value
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,1).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ IF (NSV>=1) ALLOCATE(ZSUM3(NSV))
+ ZSUM3 = 0.
+ ZSUM4 = 0.
+ IF (NRR>=1) ALLOCATE(ZSUM5(NRR))
+ ZSUM5 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ !
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,1))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTHS(JI2,JJ2,JK2)
+ IF (NRR>=1) THEN
+ DO JL = 1,NRR
+ ZSUM5(JL) = ZSUM5(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PRRS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ ZSUM3(JL) = ZSUM3(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PSVS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (CTURB/='NONE') ZSUM4 = ZSUM4 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTKS(JI2,JJ2,JK2)
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)
+ IF (NRR>=1) PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)/(1.+XRD/XRV*XRVREF(JI,JJ,JK))
+ IF (ZSUM1.GT.XIBM_EPSI) PTHS(JI,JJ,JK) = ZSUM2/ZSUM1
+ IF (NRR>=1) THEN
+ PRRS(JI,JJ,JK,1) = XRVREF(JI,JJ,JK)
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,1) = ZSUM5(1)/ZSUM1
+ IF (NRR>=2) THEN
+ DO JL = 2,NRR
+ PRRS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,JL) = ZSUM5(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ PSVS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PSVS(JI,JJ,JK,JL) = ZSUM3(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ !
+ IF (CTURB/='NONE') PTKS(JI,JJ,JK) = XTKEMIN
+ IF (ZSUM1.GT.XIBM_EPSI.AND.(CTURB/='NONE')) PTKS(JI,JJ,JK) = ZSUM4/ZSUM1
+ IF (NSV>=1) DEALLOCATE(ZSUM3)
+ IF (NRR>=1) DEALLOCATE(ZSUM5)
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,2).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,2))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,2))*PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRUS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,3).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,3))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,3))*PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRVS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,4).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,4))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,4))*PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRWS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(:,:,IKB-1)=PTHS(:,:,IKB)
+ PTHS(:,:,IKE+1)=PTHS(:,:,IKE)
+ IF (CTURB/='NONE') PTKS(:,:,IKB-1)=PTKS(:,:,IKB)
+ IF (CTURB/='NONE') PTKS(:,:,IKE+1)=PTKS(:,:,IKE)
+ IF (NSV>=1) PSVS(:,:,IKB-1,:)=PSVS(:,:,IKB,:)
+ IF (NSV>=1) PSVS(:,:,IKE+1,:)=PSVS(:,:,IKE,:)
+ IF (NRR>=1) PRRS(:,:,IKB-1,:)=PRRS(:,:,IKB,:)
+ IF (NRR>=1) PRRS(:,:,IKE+1,:)=PRRS(:,:,IKE,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING_TR::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING_TR::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ IF (NSV>=1) THEN
+ DO JL=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JL),'IBM_FORCING_TR::PSVS')
+ ENDDO
+ ENDIF
+ IF (NRR>=1) THEN
+ DO JL=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JL),'IBM_FORCING_TR::PRRS')
+ ENDDO
+ ENDIF
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ! Problems on corners ? => imposition of the adjacent value
+ !
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_LS(JI,JJ,JK,2).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI-1,JJ,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = (1.-ZSUM1)*PRUS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,3).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ-1,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = (1.-ZSUM1)*PRVS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,4).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ,JK-1))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = (1.-ZSUM1)*PRWS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING_TR
diff --git a/src/MNH/ibm_idealee.f90 b/src/MNH/ibm_idealee.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d84c60e78d77b484efa9f51f951ff237e37860c2
--- /dev/null
+++ b/src/MNH/ibm_idealee.f90
@@ -0,0 +1,260 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_IDEALEE
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_IDEALEE(KNUMB_OBS,PIBM_XYZ,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_IDEALEE
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_IDEALEE
+!
+! ###############################################
+SUBROUTINE IBM_IDEALEE(KNUMB_OBS,PIBM_XYZ,PPHI)
+ ! ###############################################
+ !
+ !
+ !**** IBM_IDEALEE computes LS function for ellipsoidal objects
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the
+ ! levetset function for many ellipsoidal objects.
+
+ ! METHOD
+ ! ------
+ !**** Use of a analytic solution and approximation in truncated cell
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_INTERPOS2
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS ! obstacle number
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ ! interface location
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS function
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX,IIU,IJU,IKU ! loop boundaries
+ REAL, ALLOCATABLE :: ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ ! saving positions/distances
+ REAL, ALLOCATABLE :: ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ
+ REAL, ALLOCATABLE :: ZCOEFA,ZCOEFB,ZDIST_REF0 ! solid volume and cell volume
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM ! mesh location (mass nodes)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATC,ZYHATC,ZZHATC ! mesh location (cell nodes)
+ CHARACTER(LEN=1) :: YPOS
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ ALLOCATE(ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ, &
+ ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ, &
+ ZCOEFA,ZCOEFB,ZDIST_REF0)
+ !
+ ALLOCATE(ZXHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZXHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZYHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZYHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZZHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZZHATM(IIU ,IJU ,IKU ))
+ !
+ JI_MIN = 1 + JPHEXT
+ JI_MAX = IIU - JPHEXT
+ JJ_MIN = 1 + JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZDIST_AXEX = PIBM_XYZ(KNUMB_OBS,2)
+ ZDIST_AXEY = PIBM_XYZ(KNUMB_OBS,4)
+ ZDIST_AXEZ = PIBM_XYZ(KNUMB_OBS,6)
+ ZPOSI_AXEX = PIBM_XYZ(KNUMB_OBS,1)
+ ZPOSI_AXEY = PIBM_XYZ(KNUMB_OBS,3)
+ ZPOSI_AXEZ = PIBM_XYZ(KNUMB_OBS,5)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ DO JM=1,7
+ !
+ IF (JM==1) THEN
+ YPOS = 'P'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==2) THEN
+ YPOS = 'U'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==3) THEN
+ YPOS = 'V'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==4) THEN
+ YPOS = 'W'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==5) THEN
+ YPOS = 'A'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==6) THEN
+ YPOS = 'B'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==7) THEN
+ YPOS = 'C'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ !
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ CALL IBM_INTERPOS2(ZXHATM,ZYHATM,ZZHATM,ZXHATC,ZYHATC,ZZHATC)
+ !
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ !
+ ! LS function
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ)
+ ZCOEFB = sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.lt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEY,ZDIST_AXEZ)
+ ZCOEFB = sqrt(((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.lt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEZ)
+ ZCOEFB =sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.lt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEY)
+ ZCOEFB = sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.)
+ !
+ ENDIF
+ !
+ ZDIST_REF0 = ZCOEFA-ZCOEFB
+ !
+ IF (PPHI(JI,JJ,JK,JM) .lt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZXHATM,ZYHATM,ZZHATM)
+ DEALLOCATE(ZXHATC,ZYHATC,ZZHATC)
+ DEALLOCATE(ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ,ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ,ZCOEFA,ZCOEFB,ZDIST_REF0)
+ !
+ RETURN
+ !
+ !------------------------------------------------------------------------------
+END SUBROUTINE IBM_IDEALEE
diff --git a/src/MNH/ibm_idealrp.f90 b/src/MNH/ibm_idealrp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5abc9cda19400cbe5efeac29dc0e6ce785a29d06
--- /dev/null
+++ b/src/MNH/ibm_idealrp.f90
@@ -0,0 +1,310 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_IDEALRP
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_IDEALRP(KNUMB_OBS,PIBM_XYZ,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_IDEALRP
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_IDEALRP
+!
+! ###############################################
+SUBROUTINE IBM_IDEALRP(KNUMB_OBS,PIBM_XYZ,PPHI)
+ ! ###############################################
+ !
+ !
+ !**** IBM_IDEALRP compute LS function for parallelepipedic objects
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the
+ ! levetset function for many parallelepipedic objects.
+ ! I_NUMB_ITER is a parameter controlling the fine resolution of
+ ! each surface
+ !
+ ! METHOD
+ ! ------
+ !**** Use of a smooth Heaviside function and a characteristic numerical interface thickness
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODE_GATHER_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_INTERPOS2
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS ! obstacle number
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ ! array for interface initialization
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM,IIU,IJU,IKU,IIU_ll,IJU_ll ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX
+ REAL :: ZDELTX,ZDELTY,ZDELTZ
+ REAL, ALLOCATABLE :: ZTEST_XMIN,ZTEST_XMAX ! saving positions
+ REAL, ALLOCATABLE :: ZTEST_YMIN,ZTEST_YMAX
+ REAL, ALLOCATABLE :: ZTEST_ZMIN,ZTEST_ZMAX
+ REAL, ALLOCATABLE :: ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2
+ REAL, ALLOCATABLE :: ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2 ! saving distances
+ REAL, ALLOCATABLE :: ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5
+ REAL, ALLOCATABLE :: ZDIST_SUR6,ZDIST_REF0
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM ! mesh location (mass nodes)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATC,ZYHATC,ZZHATC ! mesh location (cell nodes)
+ REAL, DIMENSION(:) , ALLOCATABLE :: ZXHAT_ll,ZYHAT_ll
+ CHARACTER(LEN=1) :: YPOS
+ INTEGER :: NRESP
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ JI_MIN = 1 + JPHEXT
+ JI_MAX = IIU - JPHEXT
+ JJ_MIN = 1 + JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ ALLOCATE(ZXHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZYHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZZHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZXHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZYHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZZHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZTEST_XMIN,ZTEST_XMAX,ZTEST_YMIN,ZTEST_YMAX,ZTEST_ZMIN,ZTEST_ZMAX)
+ ALLOCATE(ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2)
+ ALLOCATE(ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6,ZDIST_REF0)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
+ ALLOCATE(ZXHAT_ll(IIU_ll+ 2 * JPHEXT))
+ ALLOCATE(ZYHAT_ll(IJU_ll+ 2 * JPHEXT))
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP)
+ ZDELTX = abs((PIBM_XYZ(KNUMB_OBS,1)-PIBM_XYZ(KNUMB_OBS,2))/ &
+ ((ZXHAT_ll(IIU_ll+2)-ZXHAT_ll(2))/(IIU_ll*1.)))
+ ZDELTY = abs((PIBM_XYZ(KNUMB_OBS,3)-PIBM_XYZ(KNUMB_OBS,4))/ &
+ ((ZYHAT_ll(IJU_ll+2)-ZYHAT_ll(2))/(IJU_ll*1.)))
+ ZDELTZ = abs((PIBM_XYZ(KNUMB_OBS,5)-PIBM_XYZ(KNUMB_OBS,6))/ &
+ ((XZHAT(IKU)-XZHAT(2))/(IKU*1.-2.)))
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ DO JM=1,7
+ !
+ IF (JM==1) THEN
+ YPOS = 'P'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==2) THEN
+ YPOS = 'U'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==3) THEN
+ YPOS = 'V'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==4) THEN
+ YPOS = 'W'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==5) THEN
+ YPOS = 'A'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==6) THEN
+ YPOS = 'B'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==7) THEN
+ YPOS = 'C'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ CALL IBM_INTERPOS2(ZXHATM,ZYHATM,ZZHATM,ZXHATC,ZYHATC,ZZHATC)
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ !
+ ! LS function
+ ZTEST_XMIN = PIBM_XYZ(KNUMB_OBS,1)
+ ZTEST_XMAX = PIBM_XYZ(KNUMB_OBS,2)
+ ZTEST_YMIN = PIBM_XYZ(KNUMB_OBS,3)
+ ZTEST_YMAX = PIBM_XYZ(KNUMB_OBS,4)
+ ZTEST_ZMIN = PIBM_XYZ(KNUMB_OBS,5)
+ ZTEST_ZMAX = PIBM_XYZ(KNUMB_OBS,6)
+ !
+ ZPOSI_XYZ0 = ZTEST_XMIN
+ ZDIST_SUR1 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_YMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ0-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ1-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR1 = min(ZDIST_SUR0,ZDIST_SUR1)
+ !
+ ZPOSI_XYZ0 = ZTEST_XMAX
+ ZDIST_SUR2 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_YMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ0-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ1-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR2 = min(ZDIST_SUR0,ZDIST_SUR2)
+ !
+ ZPOSI_XYZ0 = ZTEST_YMIN
+ ZDIST_SUR3 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR3 = min(ZDIST_SUR0,ZDIST_SUR3)
+ !
+ ZPOSI_XYZ0 = ZTEST_YMAX
+ ZDIST_SUR4 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR4 = min(ZDIST_SUR0,ZDIST_SUR4)
+ !
+ ZPOSI_XYZ0 = ZTEST_ZMIN
+ ZDIST_SUR5 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_YMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR5 = min(ZDIST_SUR0,ZDIST_SUR5)
+ !
+ ZPOSI_XYZ0 = ZTEST_ZMAX
+ ZDIST_SUR6 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_YMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR6 = min(ZDIST_SUR0,ZDIST_SUR6)
+ !
+ IF ((ZXHATM(JI,JJ,JK) .gt. ZTEST_XMIN.and.ZXHATM(JI,JJ,JK) .lt. ZTEST_XMAX).and. &
+ (ZYHATM(JI,JJ,JK) .gt. ZTEST_YMIN.and.ZYHATM(JI,JJ,JK) .lt. ZTEST_YMAX).and. &
+ (ZZHATM(JI,JJ,JK) .gt. ZTEST_ZMIN.and.ZZHATM(JI,JJ,JK) .lt. ZTEST_ZMAX)) then
+ ZDIST_REF0 = +min(ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6)
+ ELSE
+ ZDIST_REF0 = -min(ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6)
+ ENDIF
+ !
+ IF (PPHI(JI,JJ,JK,JM) .lt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZXHATC,ZYHATC,ZZHATC)
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+ DEALLOCATE(ZTEST_XMIN,ZTEST_XMAX,ZTEST_YMIN,ZTEST_YMAX,ZTEST_ZMIN,ZTEST_ZMAX)
+ DEALLOCATE(ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2)
+ DEALLOCATE(ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6,ZDIST_REF0)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_IDEALRP
diff --git a/src/MNH/ibm_init.f90 b/src/MNH/ibm_init.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c5b826eeca761b3fa4a53680abcbb2673bcfa00f
--- /dev/null
+++ b/src/MNH/ibm_init.f90
@@ -0,0 +1,221 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! ####################
+MODULE MODI_IBM_INIT
+ ! ####################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INIT(PIBM_LS)
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIBM_LS
+ !
+ END SUBROUTINE IBM_INIT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INIT
+!
+! ############################
+SUBROUTINE IBM_INIT(PIBM_LS)
+ ! ############################
+ !
+ !**** *IBM_INIT* - routine to initialize the immersed boundary method
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to initialize the IBM variables
+ ! that are stored in module MODD_IBM_PARAM_n
+ !
+ ! METHOD
+ ! ------
+ ! The constants are set to their numerical values
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_SUB_MODEL_n, ONLY: XT_IBM_DETE
+ USE MODD_IBM_PARAM_n
+ USE MODD_FIELD_n
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID
+ USE MODD_GRID_n
+ USE MODD_CST
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CONF
+ USE MODD_REF_n
+ USE MODN_PARAM_n
+ !
+ ! interface
+ USE MODI_IBM_DETECT
+ USE MODI_SECOND_MNH
+ USE MODI_SHUMAN
+ USE MODI_IBM_VOLUME
+ USE MODI_GRADIENT_M
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIBM_LS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ REAL :: ZTIME1,ZTIME2
+ INTEGER :: IINFO_ll
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IIE,IIB,IJB,IJE,IKE,IKB,JN,IIU,IJU,IKU
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATION
+ ! ---------------
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU=SIZE(XZZ,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ !
+ ALLOCATE(XIBM_CURV(SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3) )) ; XIBM_CURV = 0.
+ ALLOCATE(XIBM_SU (SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3),3)) ; XIBM_SU = 0.
+ IF (LIBM_TROUBLE) THEN
+ ALLOCATE(XIBM_SUTR(SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3),4)) ; XIBM_SUTR = 1.
+ ENDIF
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZTIME1=0.
+ ZTIME2=0.
+ XT_IBM_DETE = 0.
+ CALL SECOND_MNH(ZTIME1)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !=== Level Set function
+ JN=1
+ PIBM_LS(:,:,IKB-1,JN)=2*PIBM_LS(:,:,IKB,JN)-PIBM_LS(:,:,IKB+1,JN)
+ PIBM_LS(:,:,IKE+1,JN)=2*PIBM_LS(:,:,IKE,JN)-PIBM_LS(:,:,IKE-1,JN)
+ IF (LWEST_ll ()) THEN
+ PIBM_LS(IIB ,:,:,JN) = PIBM_LS( IIB+1,:,:,JN)
+ PIBM_LS(IIB-1,:,:,JN) = PIBM_LS( IIB ,:,:,JN)
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ PIBM_LS(IIE ,:,:,JN) = PIBM_LS( IIE-1,:,:,JN)
+ PIBM_LS(IIE+1,:,:,JN) = PIBM_LS( IIE ,:,:,JN)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PIBM_LS(:,IJB ,:,JN) = PIBM_LS(:, IJB+1,:,JN)
+ PIBM_LS(:,IJB-1,:,JN) = PIBM_LS(:, IJB ,:,JN)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PIBM_LS(:,IJE ,:,JN) = PIBM_LS(:, IJE-1,:,JN)
+ PIBM_LS(:,IJE+1,:,JN) = PIBM_LS(:, IJE ,:,JN)
+ ENDIF
+ !
+ PIBM_LS(:,:,:,2)=MXM(PIBM_LS(:,:,:,1))
+ PIBM_LS(:,:,:,3)=MYM(PIBM_LS(:,:,:,1))
+ PIBM_LS(:,:,:,4)=MZM(PIBM_LS(:,:,:,1))
+ !
+ NULLIFY(TZFIELDS_ll)
+ DO JN=2,4
+ PIBM_LS(:,:,IKB-1,JN)=2*PIBM_LS(:,:,IKB,JN)-PIBM_LS(:,:,IKB+1,JN)
+ PIBM_LS(:,:,IKE+1,JN)=2*PIBM_LS(:,:,IKE,JN)-PIBM_LS(:,:,IKE-1,JN)
+ IF (LWEST_ll ()) THEN
+ PIBM_LS(IIB ,:,:,JN) = PIBM_LS( IIB+1,:,:,JN)
+ PIBM_LS(IIB-1,:,:,JN) = PIBM_LS( IIB ,:,:,JN)
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ PIBM_LS(IIE ,:,:,JN) = PIBM_LS( IIE-1,:,:,JN)
+ PIBM_LS(IIE+1,:,:,JN) = PIBM_LS( IIE ,:,:,JN)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PIBM_LS(:,IJB ,:,JN) = PIBM_LS(:, IJB+1,:,JN)
+ PIBM_LS(:,IJB-1,:,JN) = PIBM_LS(:, IJB ,:,JN)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PIBM_LS(:,IJE ,:,JN) = PIBM_LS(:, IJE-1,:,JN)
+ PIBM_LS(:,IJE+1,:,JN) = PIBM_LS(:, IJE ,:,JN)
+ ENDIF
+ ENDDO
+ WHERE (ABS(PIBM_LS(:,:,:,:)).LT.XIBM_EPSI) PIBM_LS(:,:,:,:)=2.*XIBM_EPSI
+ DO JN=1,4
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PIBM_LS(:,:,:,JN),'IBM_INIT::PIBM_LS')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !=== detection ghost/images
+ IF (IP==1) WRITE(*,*)'*IBM* detection ghost/images detection'
+ CALL IBM_DETECT(PIBM_LS)
+ IF (LIBM_TROUBLE) THEN
+ NULLIFY(TZFIELDS_ll)
+ DO JN=1,4
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SUTR(:,:,:,JN),'IBM_INIT::XIBM_SUTR')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ !
+ !=== detection surface/volumes
+ IF (IP==1) WRITE(*,*)'*IBM* surface/volumes detection'
+ CALL IBM_VOLUME(PIBM_LS,XIBM_SU)
+ NULLIFY(TZFIELDS_ll)
+ DO JN=1,3
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,JN),'IBM_INIT::XIBM_SU')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !===
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_DETE=ZTIME2-ZTIME1
+ IF (IP==1) WRITE(*,*)'*IBM* End initialization in ',XT_IBM_DETE,' s'
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INIT
diff --git a/src/MNH/ibm_init_ls.f90 b/src/MNH/ibm_init_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4ccc7dfda6d88eb56b1918e0f3369a1544cbf3f3
--- /dev/null
+++ b/src/MNH/ibm_init_ls.f90
@@ -0,0 +1,186 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_INIT_LS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INIT_LS(PPHI)
+ !
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_INIT_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INIT_LS
+!
+! ############################
+SUBROUTINE IBM_INIT_LS(PPHI)
+ ! ############################
+ !
+ !**** *IBM_INIT_LS* - routine to initialize the Level-Set function for IBM
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose is to compute the LSF at mass/velocity/vorticity nodes
+ ! to store only its value at the mass node
+ !
+ ! METHOD
+ ! ------
+ ! A preparation is done by IBM_PREP depending on the type of topography
+ ! A smoothing technique done by IBM_SMOOTH is applied if necessary
+ !
+ ! EXTERNAL
+ ! --------
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_MSG
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration,
+ USE MODD_SUB_MODEL_n, ONLY: XT_IBM_PREP
+ USE MODD_IBM_PARAM_n, ONLY: XIBM_EPSI,XIBM_IEPS
+ USE MODD_IBM_LSF, ONLY: LIBM_LSF,CIBM_TYPE,NIBM_SMOOTH,XIBM_SMOOTH
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: XUNDEF,JPHEXT,JPVEXT
+ !
+ ! interface
+ USE MODI_IBM_PREP_LS
+ USE MODI_IBM_SMOOTH_LS
+ USE MODI_SECOND_MNH
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PPHI
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZPHI ! temporary LSF
+ INTEGER :: JJ,JI,JK,IIE,IIB,IJB,IJE,IKE,IKB,IIU,IJU,IKU ! loop index
+ REAL :: ZTIME1,ZTIME2 ! computation times
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ ALLOCATE(ZPHI(SIZE(PPHI,1),SIZE(PPHI,2),SIZE(PPHI,3),7))
+ ZPHI = -XIBM_IEPS
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU=SIZE(XZZ,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ ZTIME1=0.
+ ZTIME2=0.
+ XT_IBM_PREP = 0.
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ IF (IP==1) THEN
+ !
+ IF (CIBM_TYPE == 'GENE'.OR.CIBM_TYPE == 'IDEA'.OR.CIBM_TYPE =='REAL' &
+ .OR.CIBM_TYPE == 'GEID'.OR.CIBM_TYPE == 'IDRE') THEN
+ !
+ WRITE(*,*) '****************************'
+ WRITE(*,*) '**** BEGIN LSF BUILDING ****'
+ WRITE(*,*) '****************************'
+ !
+ ELSE
+ !
+ WRITE(*,*) '*****************************'
+ WRITE(*,*) '******** LIBM = TRUE ********'
+ WRITE(*,*) '*** CIBM_TYPE IS REQUIRED ***'
+ WRITE(*,*) '******** = GENE/IDEA ********'
+ WRITE(*,*) '**** (stopped execution) ****'
+ WRITE(*,*) '*****************************'
+ !
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','IBM_INIT_LS','with IBM, CIBM_TYPE is REQUIRED')
+ !
+ ENDIF
+ ENDIF
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ CALL SECOND_MNH(ZTIME1)
+ !
+ ! LSF initialization
+ CALL IBM_PREP_LS(LIBM_LSF,CIBM_TYPE,ZPHI)
+ !
+ ! LSF smoothing
+ IF (XIBM_SMOOTH/=0.) THEN
+ IF (XIBM_SMOOTH==XUNDEF) THEN
+ XIBM_SMOOTH=XIBM_EPSI
+ NIBM_SMOOTH=1
+ ENDIF
+ IF (IP==1) WRITE(*,*)'*IBM* Smoothing is applied on LSF'
+ CALL IBM_SMOOTH_LS(NIBM_SMOOTH,XIBM_SMOOTH,ZPHI)
+ ELSE
+ IF (IP==1) WRITE(*,*)'*IBM* No smoothing is applied on LSF'
+ ENDIF
+ !
+ ! LSF storage
+ PPHI(:,:,:,1:4)=ZPHI(:,:,:,1:4)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZPHI)
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_PREP=ZTIME2-ZTIME1
+ !
+ IF (IP==1) THEN
+ WRITE(*,*) '*IBM* Time to build LSF (s):', XT_IBM_PREP
+ WRITE(*,*) '**************************'
+ WRITE(*,*) '**** END LSF BUILDING ****'
+ WRITE(*,*) '**************************'
+ ENDIF
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INIT_LS
diff --git a/src/MNH/ibm_interpos.f90 b/src/MNH/ibm_interpos.f90
new file mode 100644
index 0000000000000000000000000000000000000000..13c15531d58d9e60dbd6e984b058f5ec58a09cef
--- /dev/null
+++ b/src/MNH/ibm_interpos.f90
@@ -0,0 +1,180 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! ########################
+MODULE MODI_IBM_INTERPOS
+ ! ########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INTERPOS(PXREF,PYREF,PZREF,HPOS)
+ !
+ CHARACTER(LEN=1) , INTENT(IN) :: HPOS
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXREF,PYREF,PZREF
+ !
+ END SUBROUTINE IBM_INTERPOS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INTERPOS
+!
+! ###############################################
+SUBROUTINE IBM_INTERPOS(PXREF,PYREF,PZREF,HPOS)
+ ! ###############################################
+ !
+ !**** *IBM_INTERPOS* - routine to search location of each type of nodes
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (X,Y,Z) for (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ CHARACTER(LEN=1) , INTENT(IN) :: HPOS ! location UVWP
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXREF,PYREF,PZREF ! variable
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK ! loop index
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU = SIZE(PXREF,1)
+ IJU = SIZE(PYREF,2)
+ IKU = SIZE(PZREF,3)
+ !
+ !-----------------------------------------------------------------------------
+ !
+ IF (HPOS=='P') THEN
+ PXREF = MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MZF(XZZ)
+ ENDIF
+ IF (HPOS=='U') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MXM(MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU)))
+ PZREF = MXM(MZF(XZZ))
+ ENDIF
+ IF (HPOS=='V') THEN
+ PXREF = MYM(MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU)))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MYM(MZF(XZZ))
+ ENDIF
+ IF (HPOS=='W') THEN
+ PXREF = MZM(MXF((spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))))
+ PYREF = MZM(MYF((spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='A') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MZF(XZZ)
+ ENDIF
+ IF (HPOS=='B') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='C') THEN
+ PXREF = MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='X') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ !
+ IF (LWEST_ll( )) THEN
+ PXREF(1, :, :) = (2.*PXREF(2, :, :)-PXREF(3, :, :))
+ PYREF(1, :, :) = (2.*PYREF(2, :, :)-PYREF(3, :, :))
+ PZREF(1, :, :) = (2.*PZREF(2, :, :)-PZREF(3, :, :))
+ ENDIF
+ IF (LEAST_ll( )) THEN
+ PXREF(IIU, :, :) = (2.*PXREF(IIU-1, :, :)-PXREF(IIU-2, :, :))
+ PYREF(IIU, :, :) = (2.*PYREF(IIU-1, :, :)-PYREF(IIU-2, :, :))
+ PZREF(IIU, :, :) = (2.*PZREF(IIU-1, :, :)-PZREF(IIU-2, :, :))
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PXREF(: ,1, :) = (2.*PXREF(: ,2, :)-PXREF(: ,3, :))
+ PYREF(: ,1, :) = (2.*PYREF(: ,2, :)-PYREF(: ,3, :))
+ PZREF(: ,1, :) = (2.*PZREF(: ,2, :)-PZREF(: ,3, :))
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PXREF(: ,IJU, :) = (2.*PXREF(: ,IJU-1, :)-PXREF(: ,IJU-2, :))
+ PYREF(: ,IJU, :) = (2.*PYREF(: ,IJU-1, :)-PYREF(: ,IJU-2, :))
+ PZREF(: ,IJU, :) = (2.*PZREF(: ,IJU-1, :)-PZREF(: ,IJU-2, :))
+ ENDIF
+ !
+ PXREF(: , :, 1) = (2.*PXREF(: , :, 2)-PXREF(: , :, 3))
+ PXREF(: , :,IKU) = (2.*PXREF(: , :,IKU-1)-PXREF(: , :,IKU-2))
+ PYREF(: , :, 1) = (2.*PYREF(: , :, 2)-PYREF(: , :, 3))
+ PYREF(: , :,IKU) = (2.*PYREF(: , :,IKU-1)-PYREF(: , :,IKU-2))
+ PZREF(: , :, 1) = (2.*PZREF(: , :, 2)-PZREF(: , :, 3))
+ PZREF(: , :,IKU) = (2.*PZREF(: , :,IKU-1)-PZREF(: , :,IKU-2))
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PXREF,'IBM_INTERPOS::PXREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PYREF,'IBM_INTERPOS::PYREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PZREF,'IBM_INTERPOS::PZREF')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INTERPOS
diff --git a/src/MNH/ibm_interpos2.f90 b/src/MNH/ibm_interpos2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a0f0a5a714e1b872cf2710a456cad30e1ed36ab2
--- /dev/null
+++ b/src/MNH/ibm_interpos2.f90
@@ -0,0 +1,182 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #########################
+MODULE MODI_IBM_INTERPOS2
+ ! #########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INTERPOS2(PXREF,PYREF,PZREF,PXNEW,PYNEW,PZNEW)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXREF,PYREF,PZREF
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXNEW,PYNEW,PZNEW
+ !
+ END SUBROUTINE IBM_INTERPOS2
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INTERPOS2
+!
+! #############################################################
+SUBROUTINE IBM_INTERPOS2(PXREF,PYREF,PZREF,PXNEW,PYNEW,PZNEW)
+ ! #############################################################
+ !
+ !**** *IBM_INTERPOS2* - routine to search location of cell corners
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute cell corners for (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXREF,PYREF,PZREF ! node location
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXNEW,PYNEW,PZNEW ! cell location
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK ! loop index
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ NULLIFY(TZFIELDS_ll)
+ IIU = SIZE(PXREF,1)
+ IJU = SIZE(PYREF,2)
+ IKU = SIZE(PZREF,3)
+ !
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PXREF,'IBM_INTERPOS2::PXREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PYREF,'IBM_INTERPOS2::PYREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PZREF,'IBM_INTERPOS2::PZREF')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! along X
+ PXNEW(2:IIU,2:IJU,2:IKU) = PXREF(2:IIU-0,2:IJU-0,2:IKU-0) + PXREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PXREF(1:IIU-1,1:IJU-1,2:IKU-0) + PXREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PXREF(2:IIU-0,2:IJU-0,1:IKU-1) + PXREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PXREF(1:IIU-1,1:IJU-1,1:IKU-1) + PXREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PXNEW(2:IIU,2:IJU,2:IKU) = PXNEW(2:IIU,2:IJU,2:IKU) * (1./8.)
+ !
+ IF (LWEST_ll()) THEN
+ PXNEW(1,:,:) = (2.*PXNEW(2,:,:)-PXNEW(3,:,:))
+ PXNEW(:,1,:) = (2.*PXNEW(:,2,:)-PXNEW(:,3,:))
+ PXNEW(:,:,1) = (2.*PXNEW(:,:,2)-PXNEW(:,:,3))
+ PXNEW(1,1,:) = (2.*PXNEW(2,2,:)-PXNEW(3,3,:))
+ PXNEW(:,1,1) = (2.*PXNEW(:,2,2)-PXNEW(:,3,3))
+ PXNEW(1,:,1) = (2.*PXNEW(2,:,2)-PXNEW(3,:,3))
+ PXNEW(1,1,1) = (2.*PXNEW(2,2,2)-PXNEW(3,3,3))
+ ENDIF
+ !
+ IF (LEAST_ll()) THEN
+ PXNEW(IIU+1, :, :) = (2.*PXNEW(IIU-0, :, :)-PXNEW(IIU-1, :, :))
+ PXNEW(: ,IJU+1, :) = (2.*PXNEW(: ,IJU-0, :)-PXNEW(: ,IJU-1, :))
+ PXNEW(: , :,IKU+1) = (2.*PXNEW(: , :,IKU-0)-PXNEW(: , :,IKU-1))
+ PXNEW(IIU+1,IJU+1, :) = (2.*PXNEW(IIU-0,IJU-0, :)-PXNEW(IIU-1,IJU-1, :))
+ PXNEW(: ,IJU+1,IKU+1) = (2.*PXNEW(: ,IJU-0,IKU-0)-PXNEW(: ,IJU-1,IKU-1))
+ PXNEW(IIU+1, :,IKU+1) = (2.*PXNEW(IIU-0, :,IKU-0)-PXNEW(IIU-1, :,IKU-1))
+ PXNEW(IIU+1,IJU+1,IKU+1) = (2.*PXNEW(IIU-0,IJU-0,IKU-0)-PXNEW(IIU-1,IJU-1,IKU-1))
+ ENDIF
+ !
+ ! along Y
+ PYNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PYREF(2:IIU-0,2:IJU-0,2:IKU-0) + PYREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PYREF(1:IIU-1,1:IJU-1,2:IKU-0) + PYREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PYREF(2:IIU-0,2:IJU-0,1:IKU-1) + PYREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PYREF(1:IIU-1,1:IJU-1,1:IKU-1) + PYREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PYNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PYNEW(2:IIU,2:IJU,2:IKU) * (1./8.)
+ !
+ IF (LSOUTH_ll()) THEN
+ PYNEW(1,:,:) = (2.*PYNEW(2,:,:)-PYNEW(3,:,:))
+ PYNEW(:,1,:) = (2.*PYNEW(:,2,:)-PYNEW(:,3,:))
+ PYNEW(:,:,1) = (2.*PYNEW(:,:,2)-PYNEW(:,:,3))
+ PYNEW(1,1,:) = (2.*PYNEW(2,2,:)-PYNEW(3,3,:))
+ PYNEW(:,1,1) = (2.*PYNEW(:,2,2)-PYNEW(:,3,3))
+ PYNEW(1,:,1) = (2.*PYNEW(2,:,2)-PYNEW(3,:,3))
+ PYNEW(1,1,1) = (2.*PYNEW(2,2,2)-PYNEW(3,3,3))
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PYNEW(IIU+1, :, :) = (2.*PYNEW(IIU-0, :, :)-PYNEW(IIU-1, :, :))
+ PYNEW(: ,IJU+1, :) = (2.*PYNEW(: ,IJU-0, :)-PYNEW(: ,IJU-1, :))
+ PYNEW(: , :,IKU+1) = (2.*PYNEW(: , :,IKU-0)-PYNEW(: , :,IKU-1))
+ PYNEW(IIU+1,IJU+1, :) = (2.*PYNEW(IIU-0,IJU-0, :)-PYNEW(IIU-1,IJU-1, :))
+ PYNEW(: ,IJU+1,IKU+1) = (2.*PYNEW(: ,IJU-0,IKU-0)-PYNEW(: ,IJU-1,IKU-1))
+ PYNEW(IIU+1, :,IKU+1) = (2.*PYNEW(IIU-0, :,IKU-0)-PYNEW(IIU-1, :,IKU-1))
+ PYNEW(IIU+1,IJU+1,IKU+1) = (2.*PYNEW(IIU-0,IJU-0,IKU-0)-PYNEW(IIU-1,IJU-1,IKU-1))
+ ENDIF
+ !
+ ! along Z
+ PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PZREF(2:IIU-0,2:IJU-0,2:IKU-0) + PZREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PZREF(1:IIU-1,1:IJU-1,2:IKU-0) + PZREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PZREF(2:IIU-0,2:IJU-0,1:IKU-1) + PZREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PZREF(1:IIU-1,1:IJU-1,1:IKU-1) + PZREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) * (1./8.)
+ PZNEW(1,:,:) = (2.*PZNEW(2,:,:)-PZNEW(3,:,:))
+ PZNEW(:,1,:) = (2.*PZNEW(:,2,:)-PZNEW(:,3,:))
+ PZNEW(:,:,1) = (2.*PZNEW(:,:,2)-PZNEW(:,:,3))
+ PZNEW(1,1,:) = (2.*PZNEW(2,2,:)-PZNEW(3,3,:))
+ PZNEW(:,1,1) = (2.*PZNEW(:,2,2)-PZNEW(:,3,3))
+ PZNEW(1,:,1) = (2.*PZNEW(2,:,2)-PZNEW(3,:,3))
+ PZNEW(1,1,1) = (2.*PZNEW(2,2,2)-PZNEW(3,3,3))
+ PZNEW(IIU+1, :, :) = (2.*PZNEW(IIU-0, :, :)-PZNEW(IIU-1, :, :))
+ PZNEW(: ,IJU+1, :) = (2.*PZNEW(: ,IJU-0, :)-PZNEW(: ,IJU-1, :))
+ PZNEW(: , :,IKU+1) = (2.*PZNEW(: , :,IKU-0)-PZNEW(: , :,IKU-1))
+ PZNEW(IIU+1,IJU+1, :) = (2.*PZNEW(IIU-0,IJU-0, :)-PZNEW(IIU-1,IJU-1, :))
+ PZNEW(: ,IJU+1,IKU+1) = (2.*PZNEW(: ,IJU-0,IKU-0)-PZNEW(: ,IJU-1,IKU-1))
+ PZNEW(IIU+1, :,IKU+1) = (2.*PZNEW(IIU-0, :,IKU-0)-PZNEW(IIU-1, :,IKU-1))
+ PZNEW(IIU+1,IJU+1,IKU+1) = (2.*PZNEW(IIU-0,IJU-0,IKU-0)-PZNEW(IIU-1,IJU-1,IKU-1))
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INTERPOS2
diff --git a/src/MNH/ibm_locatcorn.f90 b/src/MNH/ibm_locatcorn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5d2cff3a75b9d75c64aac9b915f0f00ca5869c40
--- /dev/null
+++ b/src/MNH/ibm_locatcorn.f90
@@ -0,0 +1,205 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #########################
+MODULE MODI_IBM_LOCATCORN
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_LOCATCORN(IINDEX,KPOS) RESULT(PLOCAT)
+ !
+ INTEGER,DIMENSION(:) , INTENT(IN) :: IINDEX
+ INTEGER , INTENT(IN) :: KPOS
+ REAL, DIMENSION(8,3) :: PLOCAT
+ !
+ END FUNCTION IBM_LOCATCORN
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_LOCATCORN
+!
+! ##################################################
+FUNCTION IBM_LOCATCORN(IINDEX,KPOS) RESULT(PLOCAT)
+ ! ##################################################
+ !
+ !**** *IBM_LOCATCORN* - routine to search location of each type of nodes
+ ! for one cell
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (X,Y,Z) for corners of cell (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_VAR_ll, ONLY: IP
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ INTEGER, DIMENSION(:) , INTENT(IN) :: IINDEX ! IJK reference
+ INTEGER , INTENT(IN) :: KPOS ! cell type UVWP
+ REAL, DIMENSION(8,3) :: PLOCAT ! location corner
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JL ! loop index
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: JIM1,JIP1,JJM1,JJP1,JKM1,JKP1
+ REAL :: ZIP1,ZJP1,ZKP1,ZIM1,ZJM1,ZKM1
+ REAL :: ZXXP,ZYYP,ZZZP,ZDXP,ZDYP,ZDZP
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ IIU = size(XZZ,1)
+ IJU = size(XZZ,2)
+ IKU = size(XZZ,3)
+ !
+ DO JL = 1,8
+ !
+ ! corners index
+ IF (JL==1) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ !
+ JIM1=max(1 ,JI-1)
+ JJM1=max(1 ,JJ-1)
+ JKM1=max(1 ,JK-1)
+ JIP1=min(IIU,JI+1)
+ JJP1=min(IJU,JJ+1)
+ JKP1=min(IKU,JK+1)
+ !
+ IF(IINDEX(1)==0.or.IINDEX(2)==0.or.IINDEX(3)==0) WRITE(*,*) 'IINDEX(1,2,3): ', IINDEX(1),IINDEX(2),IINDEX(3)
+ ZXXP = XXHAT(IINDEX(1))
+ ZYYP = XYHAT(IINDEX(2))
+ ZZZP = XZZ(IINDEX(1),IINDEX(2),IINDEX(3))
+ ZDXP = XXHAT(IINDEX(1)+1)-XXHAT(IINDEX(1))
+ ZDYP = XYHAT(IINDEX(2)+1)-XYHAT(IINDEX(2))
+ ZDZP = XZZ(IINDEX(1),IINDEX(2),IINDEX(3)+1)-XZZ(IINDEX(1),IINDEX(2),IINDEX(3))
+ !
+ IF (KPOS==1) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==2) THEN
+ PLOCAT(JL,1) = ZXXP +(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==3) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP +(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==4) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP +(JK-IINDEX(3))*ZDZP
+ ENDIF
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END FUNCTION IBM_LOCATCORN
diff --git a/src/MNH/ibm_mixinglength.f90 b/src/MNH/ibm_mixinglength.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3e4377a57c6e0e7ec1cbf59bad83f133828d040a
--- /dev/null
+++ b/src/MNH/ibm_mixinglength.f90
@@ -0,0 +1,163 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! ############################
+MODULE MODI_IBM_MIXINGLENGTH
+ ! ############################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ END SUBROUTINE IBM_MIXINGLENGTH
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_MIXINGLENGTH
+!
+! ###################################################
+SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ ! ###################################################
+ !
+ !**** *IBM_MIXINGLENGTH* - Alteration of the mixing lenght (IBM)
+ !
+ ! PURPOSE
+ ! -------
+ ! The limitation is corrected for the immersed bonudary method:
+ ! => using the level set phi
+ ! => LM < k(-phi)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_FIELD_n
+ USE MODD_PARAMETERS
+ USE MODD_IBM_PARAM_n
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ USE MODD_CTURB
+ USE MODD_CST
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZALPHA,ZBETA
+ REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZLM,ZMU,ZLN
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll,IKU,IKB,IKE,IIB,IIE,IJB,IJE
+ REAL :: ZKARMAN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ IKU=SIZE(PLM,3)
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ !
+ ! Turbulent velocity
+ !
+ ZMU(:,:,:)= 2.*XIBM_CNU**0.25*(PTKE(:,:,:))**(1./2.) !2 correspond to KTKE
+ ZKARMAN = XKARMAN*XCED/XIBM_CNU**0.75
+ !
+ ! Mesh scale
+ !
+ ZLN(:,:,:) = (XRHODJ(:,:,:)/XRHODREF(:,:,:))**(1./3.)
+ ZLM(:,:,:) = PLM(:,:,:)
+ !
+ ! limit domain
+ !
+ ZBETA(:,:,:)= XZZ (:,:,:)
+ ZBETA(:,:,IKB:IKE) = 0.5*(XZZ(:,:,IKB+1:IKE+1)+XZZ(:,:,IKB:IKE))
+ ZBETA(:,:,IKB-1) = -0.5*(XZZ(:,:,IKB+1)+XZZ(:,:,IKB))
+ ZBETA(:,:,IKE+1) = ZBETA(:,:,IKE)
+ ZLM(:,:,:) = MIN(ZLM(:,:,:),+ZKARMAN*ZBETA(:,:,:))
+ !
+ ! limit immersed wall
+ !
+ ZLM(:,:,:) = MIN(ZLM(:,:,:),-ZKARMAN*PHI(:,:,:))
+ !
+ ! limit physical scale
+ ZALPHA(:,:,:) = MIN(9.8*XIBM_RUG,0.5*ZKARMAN*ZLN(:,:,:))
+ ZLM(:,:,:) = MAX(ZALPHA(:,:,:),ZLM(:,:,:))
+ !
+ ! Boundary condition
+ ZMU(:,:,IKB-1)= ZMU(:,:,IKB)
+ ZLM(:,:,IKB-1)= ZLM(:,:,IKB)
+ ZMU(:,:,IKE+1)= ZMU(:,:,IKE)
+ ZLM(:,:,IKE+1)= ZLM(:,:,IKE)
+ IF (LEAST_ll()) THEN
+ ZMU(IIE+1,:,:)= ZMU(IIE,:,:)
+ ZLM(IIE+1,:,:)= ZLM(IIE,:,:)
+ ENDIF
+ IF (LWEST_ll()) THEN
+ ZMU(IIB-1,:,:)= ZMU(IIB,:,:)
+ ZLM(IIB-1,:,:)= ZLM(IIB,:,:)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZMU(:,IJE+1,:)= ZMU(:,IJE,:)
+ ZLM(:,IJE+1,:)= ZLM(:,IJE,:)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ ZMU(:,IJB-1,:)= ZMU(:,IJB,:)
+ ZLM(:,IJB-1,:)= ZLM(:,IJB,:)
+ ENDIF
+ !
+ !Communication
+ PLM(:,:,:) = ZLM(:,:,:)
+ PLEPS(:,:,:) = PLM(:,:,:)
+ PMU(:,:,:) = ZMU(:,:,:)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_MIXINGLENGTH
diff --git a/src/MNH/ibm_prep_ls.f90 b/src/MNH/ibm_prep_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..22ba92cc5ff47af569358b01d21ad1c7924d32cb
--- /dev/null
+++ b/src/MNH/ibm_prep_ls.f90
@@ -0,0 +1,231 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODI_IBM_PREP_LS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
+ !
+ LOGICAL , INTENT(IN) :: OIBM
+ CHARACTER(LEN=4) , INTENT(IN) :: HIBM_TYPE
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_PREP_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_PREP_LS
+!
+! ###########################################
+SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
+ ! ###########################################
+ !
+ !
+ !**** IBM_PREP_LS computes the LS level set function
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to localize fluid-solid interface
+ ! for the immersed boundary method in the help of LS function.
+ ! This functions allow the access to interface characteristics
+ ! (normal vector, curvature,...)
+ !
+ ! METHOD
+ ! ------
+ !**** Three main steps
+ ! - read input ASCII files
+ ! - Types of topography:
+ ! IDEA : idealized obstacles (x,y coordinates)
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CONF, ONLY: NHALO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_LBC_n
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GDIV
+ USE MODI_IBM_IDEALRP
+ USE MODI_IBM_IDEALEE
+ !
+ USE MODD_GRID
+ USE MODD_CST
+ USE MODD_GRID_n
+ USE MODE_GRIDPROJ
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ LOGICAL ,INTENT(IN) :: OIBM ! flag for immersed boundary method
+ CHARACTER(LEN=4) ,INTENT(IN) :: HIBM_TYPE ! switch generalized/idealised object
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JN,JM,JNM,JL,JMM,JI,JJ,JK,JF,JV ! loop index
+ INTEGER :: IIU,IJU,KII,KJJ
+ REAL :: ZX_MIN,ZX_MAX,ZY_MIN,ZY_MAX,DX_LOW,DY_LOW,DX_HIGH,DY_HIGH
+ INTEGER :: JI2,JJ2,JK2,JI3,JJ3,JK3
+ INTEGER :: JIM1,JIP1,JIM2,JIP2,JIM4,JIP4
+ INTEGER :: JJM1,JJP1,JJM2,JJP2,JJM4,JJP4
+ INTEGER :: JI2_MIN,JI2_MAX,JJ2_MIN,JJ2_MAX
+ INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE,ILOOP,JLOOP,KLOOP
+ INTEGER :: IGRIB,IIBM_LEVEL,KIBM_LEVEL,IIBM_MIDDLE,KIBM_LEVEL2
+ INTEGER :: KIII,KJJJ,KIIM1,KIIP1,KJJM1,KJJP1
+ INTEGER :: ILUIBMIDEA,IRESPIBMGENE,ILUIBMGENE,IRESPIBMIDEA ! integers for open/read files
+ INTEGER :: IIBM_NUMB_NODE_SURF ! number of surface points (generalized case)
+ INTEGER :: IIBM_NUMB_TYPE_SURF ! number of surface type (idealized case)
+ INTEGER :: IIBM_TYPE_SURF ! type of surfaces
+ INTEGER :: IIBM_NUMB_SURF ! number of surfaces in each type
+ REAL :: ZIBM_X1,ZIBM_X2,ZIBM_Y1,ZIBM_Y2,ZIBM_Z1,ZIBM_Z2 ! location of surface points for one object
+ REAL :: ZIBM_TYPE_SURF
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZIBM_XYZ1,ZIBM_XYZ2 ! location of surface points for all object
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZV1,ZV1_2,ZV2,ZV2_2,ZV3,ZV3_2
+ REAL, DIMENSION(:,:), ALLOCATABLE :: NORM_FACES,NORM_FACES2
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_FACES,ZIBM_FACES2,ZIBM_FACES2b ! extremities of triangle faces for all object
+ REAL :: XXX,YYY,ZZZ
+ INTEGER :: IRESPIBMREAL,ILUIBMREAL ! reading/writing ASCII files
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZSURF,ZINDI,ZTMP2,ZTMP3 ! SSF and ISF functions + temporary arrays
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP,ZPHI ! temporary arrays
+ REAL :: ZLAT,ZLON,ZHEI,ZIBM_HEI ! lat/lon/z coordinates
+ INTEGER :: KNUM,KBOR,KIBM_BATMIN,KIBM_BATMAX ! index of buildings (BATI, REAL)
+ CHARACTER(LEN=10) :: YHCOUNT1 ! reading/writing ASCII files
+ CHARACTER(LEN=24) :: YHCOUNT2
+ LOGICAL :: GHCOUNT3
+ REAL :: ZXX,ZYY,ZXM2,ZYM2,ZII,ZJJ ! temporary values
+ REAL :: ZMAX1,ZMAX2,ZMAX3
+ REAL :: IIMAX,IJMAX,IKMAX
+ REAL :: ZXX1,ZYY1,ZZZ1,ZXX2,ZYY2,ZZZ2
+ REAL :: ZTES1,ZTES2,ZTES3,ZTES4,ZDIS,ZHIGH,ZHORI
+ REAL :: ZLATMIN,ZLATMAX,ZLONMIN,ZLONMAX,ZXM2MIN,ZXM2MAX, ZYM2MIN, ZYM2MAX
+ REAL :: SIGN1,SIGN2,SIGN3,SIGN4,ZHEI2
+ REAL :: ZX1,ZY1,ZX2,ZY2,ZIND
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ LOGICAL :: LCAEP,LAZF
+ CHARACTER(LEN=12) :: HFILEGENE, HFILEIDEA
+ CHARACTER(LEN=100) :: YSTRING,YSTRING2
+ INTEGER :: NS1,NS2,NS3,NS4,NS5,NS6
+ INTEGER :: ZN1,ZN2,ZN3,JCOUNT
+ REAL, DIMENSION(3) :: ZNA,ZNB
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ ILUIBMIDEA = 43
+ HFILEIDEA = "ibm_idea.nam"
+ !
+ IIU = SIZE(XXHAT)
+ IJU = SIZE(XYHAT)
+ !
+ !
+ !------------------------------------------------------------------------------
+ !
+ !* *** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ! Read input files in order to compute interface location
+ ! - 'm_ideal.nam' for idealized case
+ ! (NUMB_NODE_SURF is the number of objects)
+ ! (NUMB_TYPE_SURF is the number of surface types:
+ ! ( TYPE_SURF = 1 for parallelepipedic shape
+ ! TYPE_SURF = 2 for ellipsoidal shape)
+ ! ( NUMB_SURF is the objects number in each type)
+ !
+ !
+ IF ((HIBM_TYPE=='IDEA')) THEN
+ !
+ OPEN(ILUIBMIDEA , FILE= HFILEIDEA , IOSTAT=IRESPIBMIDEA , FORM='FORMATTED' , &
+ STATUS='OLD', ACCESS='SEQUENTIAL', ACTION='READ')
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) IIBM_NUMB_NODE_SURF, IIBM_NUMB_TYPE_SURF
+ ALLOCATE(ZIBM_XYZ2(IIBM_NUMB_NODE_SURF,7))
+ !
+ ZIBM_XYZ2(:,:) = 0.
+ JNM = 0
+ DO JN=1,IIBM_NUMB_TYPE_SURF
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) IIBM_TYPE_SURF, IIBM_NUMB_SURF
+ ZIBM_TYPE_SURF= float(IIBM_TYPE_SURF)
+ !
+ DO JM=1,IIBM_NUMB_SURF
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) ZIBM_X1,ZIBM_X2,ZIBM_Y1,ZIBM_Y2,ZIBM_Z1,ZIBM_Z2
+ !
+ JNM = JNM + 1
+ ZIBM_XYZ2(JNM,1) = ZIBM_X1 !x_mini(pp) or x_cent(ee)
+ ZIBM_XYZ2(JNM,2) = ZIBM_X2 !x_maxi(pp) or x_delt(ee)
+ ZIBM_XYZ2(JNM,3) = ZIBM_Y1 !y_mini(pp) or y_cent(ee)
+ ZIBM_XYZ2(JNM,4) = ZIBM_Y2 !y_maxi(pp) or y_delt(ee)
+ ZIBM_XYZ2(JNM,5) = ZIBM_Z1 !z_mini(pp) or z_cent(ee)
+ ZIBM_XYZ2(JNM,6) = ZIBM_Z2 !z_maxi(pp) or z_delt(ee)
+ ZIBM_XYZ2(JNM,7) = ZIBM_TYPE_SURF !surface type (1=pp/2=ee)
+ !
+ ENDDO
+ !
+ ENDDO
+ ENDIF
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! Computations of volumic fraction (VF) and Level Set function (LS) for all kinds of initialization
+ ! idealized shape => construction of VF/LS function using analytical
+ ! locations of interface (ellipsoidal/parallelepipedic shapes)
+ !
+ IF ((HIBM_TYPE=='IDEA')) then
+ DO JN=1,JNM
+ !
+ IF (abs(ZIBM_XYZ2(JN,7)-1.).lt.XIBM_EPSI) CALL IBM_IDEALRP(JN,ZIBM_XYZ2,PPHI)
+ IF (abs(ZIBM_XYZ2(JN,7)-2.).lt.XIBM_EPSI) CALL IBM_IDEALEE(JN,ZIBM_XYZ2,PPHI)
+ ENDDO
+ !
+ ENDIF
+ !
+END SUBROUTINE IBM_PREP_LS
diff --git a/src/MNH/ibm_smooth_ls.f90 b/src/MNH/ibm_smooth_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a2e98ba088c8f9444a896847456dc440960bff6d
--- /dev/null
+++ b/src/MNH/ibm_smooth_ls.f90
@@ -0,0 +1,652 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #########################
+MODULE MODI_IBM_SMOOTH_LS
+ ! #########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_SMOOTH_LS(KIBM_SMOOTH,PIBM_SMOOTH,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KIBM_SMOOTH
+ REAL ,INTENT(IN) :: PIBM_SMOOTH
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_SMOOTH_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_SMOOTH_LS
+!
+! ######################################################
+SUBROUTINE IBM_SMOOTH_LS(KIBM_SMOOTH,PIBM_SMOOTH,PPHI)
+ ! ######################################################
+ !
+ !
+ !**** IBM_SMOOTH_LS is a smoothing method for LS function
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to smooth VF/LS functions
+ ! in order to improve computations of characteristics surface
+ ! (be careful with singularities and corners)
+ !
+ ! METHOD
+ ! ------
+ !**** Iterative systems
+ ! - value at mass node weighted by values at neighboring flux nodes
+ ! - value at flux node weighted by values at neighboring mass nodes
+ !
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ USE MODD_VAR_ll, ONLY: IP
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GRADIENT_M
+ USE MODI_GRADIENT_U
+ USE MODI_GRADIENT_V
+ USE MODI_GRADIENT_W
+ USE MODI_GRADIENT_UV
+ USE MODI_GRADIENT_VW
+ USE MODI_GRADIENT_UW
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER , INTENT(IN) :: KIBM_SMOOTH ! Smooth levels
+ REAL , INTENT(IN) :: PIBM_SMOOTH ! Smooth weighting
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIB,IJB,IKB,IIE,IJE,IKE
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK,JL,JM ! loop index
+ INTEGER :: ILISPT_NUMB ! number of smooth iteration
+ REAL :: ILISPT_FACT ! smooth factor
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ REAL :: ILISPT_FACTU,ILISPT_FACTV
+ REAL :: ILISPT_FACTW,ILISPT_FACTP
+ REAL :: ZPE,ZPW,ZPB,ZPT,ZPN,ZPS
+ REAL :: ZREF,ZREF3
+ REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZTEMP
+ REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: Z_NORM_TEMP0
+ REAL,DIMENSION(:,:,:) , ALLOCATABLE :: Z_NORM_TEMP1
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ IIU=SIZE(PPHI,1)
+ IJU=SIZE(PPHI,2)
+ IKU=SIZE(PPHI,3)
+ !
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ !
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ ZREF =(1.e-2)*((XXHAT(IIB+1)-XXHAT(IIB))*(XYHAT(IJB+1)-XYHAT(IJB)))**0.5
+ ZREF3=((XXHAT(IIB+1)-XXHAT(IIB))*(XYHAT(IJB+1)-XYHAT(IJB)))**0.5
+ !
+ ! Boundary symmetry
+ !
+ PPHI(:,:,1,5) = 2.*PPHI(:,:,2,5)-PPHI(:,:,3,5)
+ PPHI(:,:,1,3) = 2.*PPHI(:,:,2,3)-PPHI(:,:,3,3)
+ PPHI(:,:,1,2) = 2.*PPHI(:,:,2,2)-PPHI(:,:,3,2)
+ PPHI(:,:,1,1) = 2.*PPHI(:,:,2,1)-PPHI(:,:,3,1)
+ WHERE (PPHI(:,:,2,5).GT.XIBM_EPSI) PPHI(:,:,1,5) = PPHI(:,:,2,5)
+ WHERE (PPHI(:,:,2,3).GT.XIBM_EPSI) PPHI(:,:,1,3) = PPHI(:,:,2,3)
+ WHERE (PPHI(:,:,2,2).GT.XIBM_EPSI) PPHI(:,:,1,2) = PPHI(:,:,2,2)
+ WHERE (PPHI(:,:,2,1).GT.XIBM_EPSI) PPHI(:,:,1,1) = PPHI(:,:,2,1)
+ PPHI(:,:,2,6) = (PPHI(:,:,2,2)+PPHI(:,:,1,2))/2.
+ PPHI(:,:,2,7) = (PPHI(:,:,2,3)+PPHI(:,:,1,3))/2.
+ PPHI(:,:,2,4) = (PPHI(:,:,2,1)+PPHI(:,:,1,1))/2.
+ PPHI(:,:,1,6) = 2.*PPHI(:,:,2,6)-PPHI(:,:,3,6)
+ PPHI(:,:,1,7) = 2.*PPHI(:,:,2,7)-PPHI(:,:,3,7)
+ PPHI(:,:,1,4) = 2.*PPHI(:,:,2,4)-PPHI(:,:,3,4)
+ WHERE (PPHI(:,:,2,6).GT.XIBM_EPSI) PPHI(:,:,1,6) = PPHI(:,:,2,6)
+ WHERE (PPHI(:,:,2,7).GT.XIBM_EPSI) PPHI(:,:,1,7) = PPHI(:,:,2,7)
+ WHERE (PPHI(:,:,2,4).GT.XIBM_EPSI) PPHI(:,:,1,4) = PPHI(:,:,2,4)
+ !
+ PPHI(:,:,IKU,5) = 2.*PPHI(:,:,IKU-1,5)-PPHI(:,:,IKU-2,5)
+ PPHI(:,:,IKU,3) = 2.*PPHI(:,:,IKU-1,3)-PPHI(:,:,IKU-2,3)
+ PPHI(:,:,IKU,2) = 2.*PPHI(:,:,IKU-1,2)-PPHI(:,:,IKU-2,2)
+ PPHI(:,:,IKU,1) = 2.*PPHI(:,:,IKU-1,1)-PPHI(:,:,IKU-2,1)
+ WHERE (PPHI(:,:,IKU-1,5).GT.XIBM_EPSI) PPHI(:,:,IKU,5) = PPHI(:,:,IKU-1,5)
+ WHERE (PPHI(:,:,IKU-1,3).GT.XIBM_EPSI) PPHI(:,:,IKU,3) = PPHI(:,:,IKU-1,3)
+ WHERE (PPHI(:,:,IKU-1,2).GT.XIBM_EPSI) PPHI(:,:,IKU,2) = PPHI(:,:,IKU-1,2)
+ WHERE (PPHI(:,:,IKU-1,1).GT.XIBM_EPSI) PPHI(:,:,IKU,1) = PPHI(:,:,IKU-1,1)
+ PPHI(:,:,IKU,6) = (PPHI(:,:,IKU-1,2)+PPHI(:,:,IKU,2))/2.
+ PPHI(:,:,IKU,7) = (PPHI(:,:,IKU-1,3)+PPHI(:,:,IKU,3))/2.
+ PPHI(:,:,IKU,4) = (PPHI(:,:,IKU-1,1)+PPHI(:,:,IKU,1))/2.
+ WHERE (PPHI(:,:,IKU-1,6).GT.XIBM_EPSI) PPHI(:,:,IKU,6) = PPHI(:,:,IKU-1,6)
+ WHERE (PPHI(:,:,IKU-1,7).GT.XIBM_EPSI) PPHI(:,:,IKU,7) = PPHI(:,:,IKU-1,7)
+ WHERE (PPHI(:,:,IKU-1,4).GT.XIBM_EPSI) PPHI(:,:,IKU,4) = PPHI(:,:,IKU-1,4)
+ !
+ DO JL=1,7
+ !
+ IF (LWEST_ll ()) PPHI(2 ,:,:,JL) = PPHI( 3,:,:,JL)
+ IF (LEAST_ll ()) PPHI(IIU-1,:,:,JL) = PPHI(IIU-2,:,:,JL)
+ IF (LSOUTH_ll()) PPHI(:,2 ,:,JL) = PPHI(:, 3,:,JL)
+ IF (LNORTH_ll()) PPHI(:,IJU-1,:,JL) = PPHI(:,IJU-2,:,JL)
+ IF (LWEST_ll ()) PPHI(1 ,:,:,JL) = PPHI( 2,:,:,JL)
+ IF (LEAST_ll ()) PPHI(IIU,:,:,JL) = PPHI(IIU-1,:,:,JL)
+ IF (LSOUTH_ll()) PPHI(:,1 ,:,JL) = PPHI(:, 2,:,JL)
+ IF (LNORTH_ll()) PPHI(:,IJU,:,JL) = PPHI(:,IJU-1,:,JL)
+ !
+ IF(LWEST_ll()) THEN
+ PPHI(IIB-1,IJB:IJE,IKB-1,JL)=PPHI(IIB-1,IJB:IJE,IKB,JL)
+ PPHI(IIB-1,IJB:IJE,IKE+1,JL)=PPHI(IIB-1,IJB:IJE,IKE,JL)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ PPHI(IIE+1,IJB:IJE,IKB-1,JL)=PPHI(IIE+1,IJB:IJE,IKB,JL)
+ PPHI(IIE+1,IJB:IJE,IKE+1,JL)=PPHI(IIE+1,IJB:IJE,IKE,JL)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ PPHI(IIB:IIE,IJB-1,IKB-1,JL)=PPHI(IIB:IIE,IJB-1,IKB,JL)
+ PPHI(IIB:IIE,IJB-1,IKE+1,JL)=PPHI(IIB:IIE,IJB-1,IKE,JL)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ PPHI(IIB:IIE,IJE+1,IKB-1,JL)=PPHI(IIB:IIE,IJE+1,IKB,JL)
+ PPHI(IIB:IIE,IJE+1,IKE+1,JL)=PPHI(IIB:IIE,IJE+1,IKE,JL)
+ END IF
+ !
+ WHERE (ABS(PPHI(:,:,:,JL)).LT.(ZREF-2.*XIBM_EPSI)) PPHI(:,:,:,JL) = ZREF-XIBM_EPSI
+ !
+ ENDDO
+ !
+ NULLIFY(TZFIELDS_ll)
+ !
+ DO JL=1,7
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,JL),'IBM_SMOOTH_LS::PPHI')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ IF (KIBM_SMOOTH==0) RETURN
+ !
+ ALLOCATE(ZTEMP(IIU,IJU,IKU,7))
+ ALLOCATE(Z_NORM_TEMP0(IIU,IJU,IKU,3,7),Z_NORM_TEMP1(IIU,IJU,IKU))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ! LISPT_NUMB correspond to the number of iteration
+ ! LISPT_FACT correspond to correspond to the weight between mass/flux nodes
+ !
+ ILISPT_NUMB=KIBM_SMOOTH
+ ILISPT_FACT=PIBM_SMOOTH
+ !
+ IF (IP==1) WRITE(*,*) 'NIBM_SMOOTH,XIBM_SMOOTH' , ILISPT_NUMB,ILISPT_FACT
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! Techniques to compute with an accurate precision
+ ! the normal vector to the interface, the local curvature
+ !
+ DO JL = 1,ILISPT_NUMB
+ !
+ Z_NORM_TEMP0(:,:,:,:,:)=1.
+ !
+ IF (MOD(JL,2)==0.AND.JL>3) THEN
+ NULLIFY(TZFIELDS_ll)
+ DO JM=1,4
+ IF (JM==1) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ ENDIF
+ IF (JM==2) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_M_U(1,IKU,1,PPHI(:,:,:,1),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_UV_U(PPHI(:,:,:,5),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_UW_U(PPHI(:,:,:,6),XDZZ)
+ ENDIF
+ IF (JM==3) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_UV_V(PPHI(:,:,:,5),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = - GY_M_V(1,IKU,1,PPHI(:,:,:,1),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_VW_V(PPHI(:,:,:,7),XDZZ)
+ ENDIF
+ IF (JM==4) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_UW_W(PPHI(:,:,:,6),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_VW_W(PPHI(:,:,:,7),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = - GZ_M_W(1,IKU,1,PPHI(:,:,:,1),XDZZ)
+ ENDIF
+ Z_NORM_TEMP1(:,:,:)=(ABS(Z_NORM_TEMP0(:,:,:,1,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,2,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,3,JM)))
+ WHERE (Z_NORM_TEMP1(:,:,:).GT.XIBM_EPSI)
+ Z_NORM_TEMP0(:,:,:,1,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,1,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,2,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,3,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ ELSEWHERE
+ Z_NORM_TEMP0(:,:,:,1,JM)=1.
+ Z_NORM_TEMP0(:,:,:,2,JM)=1.
+ Z_NORM_TEMP0(:,:,:,3,JM)=1.
+ ENDWHERE
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,1,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,2,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,3,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ IF (JM==4) THEN
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ ENDDO
+ NULLIFY(TZFIELDS_ll)
+ DO JM=5,7
+ IF (JM==5) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MXM(Z_NORM_TEMP0(:,:,:,1,3))+MYM(Z_NORM_TEMP0(:,:,:,1,2)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MXM(Z_NORM_TEMP0(:,:,:,2,3))+MYM(Z_NORM_TEMP0(:,:,:,2,2)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MXM(Z_NORM_TEMP0(:,:,:,3,3))+MYM(Z_NORM_TEMP0(:,:,:,3,2)))/2.
+ ENDIF
+ IF (JM==6) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MXM(Z_NORM_TEMP0(:,:,:,1,4))+MZM(Z_NORM_TEMP0(:,:,:,1,2)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MXM(Z_NORM_TEMP0(:,:,:,2,4))+MZM(Z_NORM_TEMP0(:,:,:,2,2)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MXM(Z_NORM_TEMP0(:,:,:,3,4))+MZM(Z_NORM_TEMP0(:,:,:,3,2)))/2.
+ ENDIF
+ IF (JM==7) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MYM(Z_NORM_TEMP0(:,:,:,1,4))+MZM(Z_NORM_TEMP0(:,:,:,1,3)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MYM(Z_NORM_TEMP0(:,:,:,2,4))+MZM(Z_NORM_TEMP0(:,:,:,2,3)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MYM(Z_NORM_TEMP0(:,:,:,3,4))+MZM(Z_NORM_TEMP0(:,:,:,3,3)))/2.
+ ENDIF
+ Z_NORM_TEMP1(:,:,:)=(ABS(Z_NORM_TEMP0(:,:,:,1,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,2,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,3,JM)))
+ WHERE (Z_NORM_TEMP1(:,:,:).GT.XIBM_EPSI)
+ Z_NORM_TEMP0(:,:,:,1,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,1,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,2,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,3,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ ELSEWHERE
+ Z_NORM_TEMP0(:,:,:,1,JM)=1.
+ Z_NORM_TEMP0(:,:,:,2,JM)=1.
+ Z_NORM_TEMP0(:,:,:,3,JM)=1.
+ ENDWHERE
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,1,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,2,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,3,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ IF (JM==7) THEN
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ ZTEMP=PPHI
+ !
+ DO JK=1,IKU-1
+ DO JJ=1,IJU-1
+ DO JI=2,IIU
+ !
+ ILISPT_FACTU = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,2))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI-1,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,1,2)
+ ZPE = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,1,2)
+ ZPB = PPHI(JI ,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,2,2)
+ ZPT = PPHI(JI ,JJ+1,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,2,2)
+ ZPS = PPHI(JI ,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,3,2)
+ ZPN = PPHI(JI ,JJ ,JK+1,6)*Z_NORM_TEMP0(JI,JJ,JK,3,2)
+ !
+ ZTEMP(JI,JJ,JK,2) = (0.+ILISPT_FACTU)*PPHI(JI,JJ,JK,2)+ &
+ (1.-ILISPT_FACTU)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=1,IKU-1
+ DO JJ=2,IJU
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTV = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,3))/ILISPT_FACT)
+ !
+ ZPS = PPHI(JI ,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,1,3)
+ ZPN = PPHI(JI+1,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,1,3)
+ ZPW = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,2,3)
+ ZPE = PPHI(JI ,JJ-1,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,2,3)
+ ZPB = PPHI(JI ,JJ ,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,3,3)
+ ZPT = PPHI(JI ,JJ ,JK+1,7)*Z_NORM_TEMP0(JI,JJ,JK,3,3)
+ !
+ ZTEMP(JI,JJ,JK,3) = (0.+ILISPT_FACTV)*PPHI(JI,JJ,JK,3)+ &
+ (1.-ILISPT_FACTV)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=1,IJU-1
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTW = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,4))/ILISPT_FACT)
+ !
+ ZPB = PPHI(JI ,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,1,4)
+ ZPT = PPHI(JI+1,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,1,4)
+ ZPW = PPHI(JI ,JJ ,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,2,4)
+ ZPE = PPHI(JI ,JJ+1,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,2,4)
+ ZPS = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,3,4)
+ ZPN = PPHI(JI ,JJ ,JK-1,1)*Z_NORM_TEMP0(JI,JJ,JK,3,4)
+ !
+ ZTEMP(JI,JJ,JK,4) = (0.+ILISPT_FACTW)*PPHI(JI,JJ,JK,4)+ &
+ (1.-ILISPT_FACTW)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU-1
+ DO JJ=2,IJU-1
+ DO JI=2,IIU-1
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,1))/ILISPT_FACT)
+ !
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,1,1)
+ ZPT = PPHI(JI+1,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,1,1)
+ ZPW = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,2,1)
+ ZPE = PPHI(JI ,JJ+1,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,2,1)
+ ZPS = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,3,1)
+ ZPN = PPHI(JI ,JJ ,JK+1,4)*Z_NORM_TEMP0(JI,JJ,JK,3,1)
+ !
+ ZTEMP(JI,JJ,JK,1) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,1)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=1,IKU-1
+ DO JJ=2,IJU
+ DO JI=2,IIU
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,5))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,1,5)
+ ZPE = PPHI(JI-1,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,1,5)
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,2,5)
+ ZPT = PPHI(JI ,JJ-1,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,2,5)
+ ZPS = (PPHI(JI ,JJ ,JK ,4)+PPHI(JI-1,JJ-1,JK ,4)+PPHI(JI-1,JJ ,JK ,4)+PPHI(JI ,JJ-1,JK ,4))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,3,5)
+ ZPN = (PPHI(JI ,JJ ,JK+1,4)+PPHI(JI-1,JJ-1,JK+1,4)+PPHI(JI-1,JJ ,JK+1,4)+PPHI(JI ,JJ-1,JK+1,4))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,3,5)
+ !
+ ZTEMP(JI,JJ,JK,5) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,5)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPS+ZPN)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=1,IJU-1
+ DO JI=2,IIU
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,6))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI-1,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,1,6)
+ ZPE = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,1,6)
+ ZPS = (PPHI(JI ,JJ ,JK ,3)+PPHI(JI-1,JJ ,JK-1,3)+PPHI(JI-1,JJ ,JK ,3)+PPHI(JI ,JJ ,JK-1,3))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,2,6)
+ ZPN = (PPHI(JI ,JJ+1,JK ,3)+PPHI(JI-1,JJ+1,JK-1,3)+PPHI(JI-1,JJ+1,JK ,3)+PPHI(JI ,JJ+1,JK-1,3))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,2,6)
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,3,6)
+ ZPT = PPHI(JI ,JJ ,JK-1,2)*Z_NORM_TEMP0(JI,JJ,JK,3,6)
+ !
+ ZTEMP(JI,JJ,JK,6) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,6)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPS+ZPN)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=2,IJU
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,7))/ILISPT_FACT)
+ !
+ ZPW = (PPHI(JI ,JJ ,JK ,2)+PPHI(JI ,JJ-1,JK-1,2)+PPHI(JI ,JJ-1,JK ,2)+PPHI(JI ,JJ ,JK-1,2))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,1,7)
+ ZPE = (PPHI(JI+1,JJ ,JK ,2)+PPHI(JI+1,JJ-1,JK-1,2)+PPHI(JI+1,JJ-1,JK ,2)+PPHI(JI+1,JJ ,JK-1,2))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,1,7)
+ ZPB = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,2,7)
+ ZPT = PPHI(JI ,JJ-1,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,2,7)
+ ZPS = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,3,7)
+ ZPN = PPHI(JI ,JJ ,JK-1,3)*Z_NORM_TEMP0(JI,JJ,JK,3,7)
+ !
+ ZTEMP(JI,JJ,JK,7) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,7)+ &
+ (1.-ILISPT_FACTP)*(ZPB+ZPT+ZPN+ZPS+ZPW+ZPE)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ IF (JL>4) THEN
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,4)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,4)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,1) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB-1:IIE-1,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,6)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,2) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB-1:IJE-1,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,7)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,3) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB:IJE,IKB-1:IKE-1,1)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,4) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,4)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,4)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,1) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB-1:IIE-1,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,6)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,2) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB-1:IJE-1,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,7)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,3) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB:IJE,IKB-1:IKE-1,1)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,4) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB :IIE ,IJB:IJE,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB-1:IIE-1,IJB:IJE,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB:IIE,IJB :IJE ,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB:IIE,IJB-1:IJE-1,2,2)).AND.PPHI(IIB:IIE,IJB:IJE,2,5).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,5) =PPHI(IIB:IIE,IJB:IJE,2,5)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB :IIE ,IJB:IJE,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB-1:IIE-1,IJB:IJE,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB:IIE,IJB :IJE ,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB:IIE,IJB+1:IJE+1,2,5)).AND.PPHI(IIB:IIE,IJB:IJE,2,2).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,2) =PPHI(IIB:IIE,IJB:IJE,2,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB :IIE ,IJB:IJE,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB+1:IIE+1,IJB:IJE,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB:IIE,IJB :IJE ,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB:IIE,IJB-1:IJE-1,2,1)).AND.PPHI(IIB:IIE,IJB:IJE,2,3).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,3) =PPHI(IIB:IIE,IJB:IJE,2,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB :IIE ,IJB:IJE,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB+1:IIE+1,IJB:IJE,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB:IIE,IJB :IJE ,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB:IIE,IJB+1:IJE+1,2,3)).AND.PPHI(IIB:IIE,IJB:IJE,2,1).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,1) =PPHI(IIB:IIE,IJB:IJE,2,1)
+ ENDWHERE
+ ENDIF
+ !
+ ZTEMP(:,:,1,5) = 2.*ZTEMP(:,:,2,5)-ZTEMP(:,:,3,5)
+ ZTEMP(:,:,1,3) = 2.*ZTEMP(:,:,2,3)-ZTEMP(:,:,3,3)
+ ZTEMP(:,:,1,2) = 2.*ZTEMP(:,:,2,2)-ZTEMP(:,:,3,2)
+ ZTEMP(:,:,1,1) = 2.*ZTEMP(:,:,2,1)-ZTEMP(:,:,3,1)
+ WHERE (ZTEMP(:,:,2,5).GT.XIBM_EPSI) ZTEMP(:,:,1,5) = ZTEMP(:,:,2,5)
+ WHERE (ZTEMP(:,:,2,3).GT.XIBM_EPSI) ZTEMP(:,:,1,3) = ZTEMP(:,:,2,3)
+ WHERE (ZTEMP(:,:,2,2).GT.XIBM_EPSI) ZTEMP(:,:,1,2) = ZTEMP(:,:,2,2)
+ WHERE (ZTEMP(:,:,2,1).GT.XIBM_EPSI) ZTEMP(:,:,1,1) = ZTEMP(:,:,2,1)
+ ZTEMP(:,:,2,6) = (ZTEMP(:,:,2,2)+ZTEMP(:,:,1,2))/2.
+ ZTEMP(:,:,2,7) = (ZTEMP(:,:,2,3)+ZTEMP(:,:,1,3))/2.
+ ZTEMP(:,:,2,4) = (ZTEMP(:,:,2,1)+ZTEMP(:,:,1,1))/2.
+ ZTEMP(:,:,1,6) = 2.*ZTEMP(:,:,2,6)-ZTEMP(:,:,3,6)
+ ZTEMP(:,:,1,7) = 2.*ZTEMP(:,:,2,7)-ZTEMP(:,:,3,7)
+ ZTEMP(:,:,1,4) = 2.*ZTEMP(:,:,2,4)-ZTEMP(:,:,3,4)
+ WHERE (ZTEMP(:,:,2,6).GT.XIBM_EPSI) ZTEMP(:,:,1,6) = ZTEMP(:,:,2,6)
+ WHERE (ZTEMP(:,:,2,7).GT.XIBM_EPSI) ZTEMP(:,:,1,7) = ZTEMP(:,:,2,7)
+ WHERE (ZTEMP(:,:,2,4).GT.XIBM_EPSI) ZTEMP(:,:,1,4) = ZTEMP(:,:,2,4)
+ ZTEMP(:,:,IKU,5) = 2.*ZTEMP(:,:,IKU-1,5)-ZTEMP(:,:,IKU-2,5)
+ ZTEMP(:,:,IKU,3) = 2.*ZTEMP(:,:,IKU-1,3)-ZTEMP(:,:,IKU-2,3)
+ ZTEMP(:,:,IKU,2) = 2.*ZTEMP(:,:,IKU-1,2)-ZTEMP(:,:,IKU-2,2)
+ ZTEMP(:,:,IKU,1) = 2.*ZTEMP(:,:,IKU-1,1)-ZTEMP(:,:,IKU-2,1)
+ WHERE (ZTEMP(:,:,IKU-1,5).GT.XIBM_EPSI) ZTEMP(:,:,IKU,5) = ZTEMP(:,:,IKU-1,5)
+ WHERE (ZTEMP(:,:,IKU-1,3).GT.XIBM_EPSI) ZTEMP(:,:,IKU,3) = ZTEMP(:,:,IKU-1,3)
+ WHERE (ZTEMP(:,:,IKU-1,2).GT.XIBM_EPSI) ZTEMP(:,:,IKU,2) = ZTEMP(:,:,IKU-1,2)
+ WHERE (ZTEMP(:,:,IKU-1,1).GT.XIBM_EPSI) ZTEMP(:,:,IKU,1) = ZTEMP(:,:,IKU-1,1)
+ ZTEMP(:,:,IKU,6) = (ZTEMP(:,:,IKU-1,2)+ZTEMP(:,:,IKU,2))/2.
+ ZTEMP(:,:,IKU,7) = (ZTEMP(:,:,IKU-1,3)+ZTEMP(:,:,IKU,3))/2.
+ ZTEMP(:,:,IKU,4) = (ZTEMP(:,:,IKU-1,1)+ZTEMP(:,:,IKU,1))/2.
+ WHERE (ZTEMP(:,:,IKU-1,6).GT.XIBM_EPSI) ZTEMP(:,:,IKU,6) = ZTEMP(:,:,IKU-1,6)
+ WHERE (ZTEMP(:,:,IKU-1,7).GT.XIBM_EPSI) ZTEMP(:,:,IKU,7) = ZTEMP(:,:,IKU-1,7)
+ WHERE (ZTEMP(:,:,IKU-1,4).GT.XIBM_EPSI) ZTEMP(:,:,IKU,4) = ZTEMP(:,:,IKU-1,4)
+ !
+ WHERE (ABS(ZTEMP(:,:,:,:)).LT.(ZREF-2.*XIBM_EPSI)) ZTEMP(:,:,:,:) = ZREF-XIBM_EPSI
+ !
+ NULLIFY(TZFIELDS_ll)
+ DO JM=1,7
+ ! Boundary symmetry
+ IF (LWEST_ll ()) ZTEMP(2 ,:,:,JM) = ZTEMP( 3,:,:,JM)
+ IF (LEAST_ll ()) ZTEMP(IIU-1,:,:,JM) = ZTEMP(IIU-2,:,:,JM)
+ IF (LSOUTH_ll()) ZTEMP(:,2 ,:,JM) = ZTEMP(:, 3,:,JM)
+ IF (LNORTH_ll()) ZTEMP(:,IJU-1,:,JM) = ZTEMP(:,IJU-2,:,JM)
+ IF (LWEST_ll ()) ZTEMP(1 ,:,:,JM) = ZTEMP( 2,:,:,JM)
+ IF (LEAST_ll ()) ZTEMP(IIU,:,:,JM) = ZTEMP(IIU-1,:,:,JM)
+ IF (LSOUTH_ll()) ZTEMP(:,1 ,:,JM) = ZTEMP(:, 2,:,JM)
+ IF (LNORTH_ll()) ZTEMP(:,IJU,:,JM) = ZTEMP(:,IJU-1,:,JM)
+ !
+ IF(LWEST_ll()) THEN
+ ZTEMP(IIB-1,IJB:IJE,IKB-1,JM)=ZTEMP(IIB-1,IJB:IJE,IKB,JM)
+ ZTEMP(IIB-1,IJB:IJE,IKE+1,JM)=ZTEMP(IIB-1,IJB:IJE,IKE,JM)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ ZTEMP(IIE+1,IJB:IJE,IKB-1,JM)=ZTEMP(IIE+1,IJB:IJE,IKB,JM)
+ ZTEMP(IIE+1,IJB:IJE,IKE+1,JM)=ZTEMP(IIE+1,IJB:IJE,IKE,JM)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ ZTEMP(IIB:IIE,IJB-1,IKB-1,JM)=ZTEMP(IIB:IIE,IJB-1,IKB,JM)
+ ZTEMP(IIB:IIE,IJB-1,IKE+1,JM)=ZTEMP(IIB:IIE,IJB-1,IKE,JM)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ ZTEMP(IIB:IIE,IJE+1,IKB-1,JM)=ZTEMP(IIB:IIE,IJE+1,IKB,JM)
+ ZTEMP(IIB:IIE,IJE+1,IKE+1,JM)=ZTEMP(IIB:IIE,IJE+1,IKE,JM)
+ END IF
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTEMP(:,:,:,JM),'IBM_SMOOTH_LS::ZTEMP')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ PPHI = ZTEMP
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZTEMP,Z_NORM_TEMP0,Z_NORM_TEMP1)
+ RETURN
+ !
+END SUBROUTINE IBM_SMOOTH_LS
diff --git a/src/MNH/ibm_valuecorn.f90 b/src/MNH/ibm_valuecorn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ebab4f11e73eae4ae226acf369841f08df1bf1cd
--- /dev/null
+++ b/src/MNH/ibm_valuecorn.f90
@@ -0,0 +1,160 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #########################
+MODULE MODI_IBM_VALUECORN
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUECORN(PVAR,IINDEX) RESULT(PVALUE)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PVAR
+ INTEGER,DIMENSION(:) , INTENT(IN) :: IINDEX
+ REAL, DIMENSION(8) :: PVALUE
+ !
+ END FUNCTION IBM_VALUECORN
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUECORN
+!
+! ##################################################
+FUNCTION IBM_VALUECORN(PVAR,IINDEX) RESULT(PVALUE)
+ ! ##################################################
+ !
+ !**** *IBM_VALUECORN* - routine to affect values at cornes cell
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (VAR) at corners of cell (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PVAR ! variable array
+ INTEGER, DIMENSION(:) ,INTENT(IN) :: IINDEX ! IJK reference
+ REAL, DIMENSION(8) :: PVALUE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JL ! loop index
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ DO JL = 1,8
+ !
+ ! corners index
+ IF (JL==1) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ !
+ PVALUE(JL) = PVAR(JI,JJ,JK)
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUECORN
diff --git a/src/MNH/ibm_valuemat1.f90 b/src/MNH/ibm_valuemat1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e985b7975a861660f2d9836d13f014224a848171
--- /dev/null
+++ b/src/MNH/ibm_valuemat1.f90
@@ -0,0 +1,208 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #########################
+MODULE MODI_IBM_VALUEMAT1
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUEMAT1(PLOCATG,PLOCATI,PVELOCI,HINTERP) RESULT(PMATRIX)
+ !
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATG
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PVELOCI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL, DIMENSION(3,3) :: PMATRIX
+ !
+ END FUNCTION IBM_VALUEMAT1
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUEMAT1
+!
+! #######################################################################
+FUNCTION IBM_VALUEMAT1(PLOCATG,PLOCATI,PVELOCI,HINTERP) RESULT(PMATRIX)
+ ! #######################################################################
+ !
+ !**** *IBM_INTER_VALUEMAT1* - Change of basis (u,v,w) to (n,t,c)
+ !
+ ! PURPOSE
+ ! -------
+ ! This function calculates the vector normal to the interface, the
+ ! tangent and binormal vectors in order to project the basis
+ ! (u,v,w) to (n,t,c). The projection is stored in the PMATRIX matrix.
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! HINTERP can be defined as HIBM_TYPE_BOUND in regard of the tangent vector:
+ ! HIBM_TYPE_BOUND="CST" (Image 1 direction)
+ ! HIBM_TYPE_BOUND="LIN" (linear evolution)
+ ! HIBM_TYPE_BOUND="LOG" (logarithmic evol)
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ !
+ ! interface
+ USE MODD_IBM_PARAM_n
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATG
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PVELOCI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL, DIMENSION(3,3) :: PMATRIX
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JH,JLL,JL1,JL2
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMAGE_VECT
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMAGE_TEMP
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_NORMA_VECT
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_TANGE_VECT
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_BINOR_VECT
+ REAL :: Z_NORMA_TEMP,Z_PRODV_TEMP
+ REAL :: Z_COEFI1,Z_COEFI2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(Z_IMAGE_VECT(4,3),Z_IMAGE_TEMP(4,3))
+ ALLOCATE(Z_NORMA_VECT(3),Z_TANGE_VECT(3),Z_BINOR_VECT(3))
+ !
+ Z_IMAGE_VECT(:,:) = 0.
+ Z_IMAGE_TEMP(:,:) = 0.
+ Z_NORMA_VECT(:) = 0.
+ Z_TANGE_VECT(:) = 0.
+ Z_BINOR_VECT(:) = 0.
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! vec(n)
+ Z_NORMA_VECT(:) = PLOCATI(:)-PLOCATG(:)
+ Z_NORMA_TEMP = sqrt(Z_NORMA_VECT(1)**2.+Z_NORMA_VECT(2)**2.+Z_NORMA_VECT(3)**2.)+XIBM_EPSI
+ Z_NORMA_VECT(:) = Z_NORMA_VECT(:) / Z_NORMA_TEMP
+ !
+ ! vec(v)
+ DO JL=1,2
+ IF (JL==1) JL1=0
+ IF (JL==2) JL2=0
+ Z_IMAGE_TEMP(JL,1) = sqrt(PVELOCI(JL,1)**2.+PVELOCI(JL,2)**2.+PVELOCI(JL,3)**2.)
+ Z_PRODV_TEMP = ABS((PVELOCI(JL,2)*Z_NORMA_VECT(3)-PVELOCI(JL,3)*Z_NORMA_VECT(2))+ &
+ (PVELOCI(JL,3)*Z_NORMA_VECT(1)-PVELOCI(JL,1)*Z_NORMA_VECT(3))+ &
+ (PVELOCI(JL,1)*Z_NORMA_VECT(2)-PVELOCI(JL,2)*Z_NORMA_VECT(1))+XIBM_EPSI)
+ IF (Z_IMAGE_TEMP(JL,1).gt.XIBM_EPSI.and.Z_PRODV_TEMP.gt.XIBM_EPSI) THEN
+ Z_IMAGE_VECT(JL,:) = PVELOCI(JL,:)/Z_IMAGE_TEMP(JL,1)
+ ELSE
+ IF (JL==1) JL1=1
+ IF (JL==2) JL2=1
+ Z_NORMA_TEMP = XIBM_IEPS
+ DO JLL=1,3
+ IF (abs(Z_NORMA_VECT(JLL)).lt.Z_NORMA_TEMP) THEN
+ Z_NORMA_TEMP = abs(Z_NORMA_VECT(JLL))
+ JH = JLL
+ ENDIF
+ ENDDO
+ Z_IMAGE_VECT(JL,:) = 0.
+ Z_IMAGE_VECT(JL,JH) = 1.
+ ENDIF
+ ENDDO
+ !
+ IF (JL1==1.AND.JL2==0) Z_IMAGE_VECT(1,:)=Z_IMAGE_VECT(2,:)
+ IF (JL2==1.AND.JL1==0) Z_IMAGE_VECT(2,:)=Z_IMAGE_VECT(1,:)
+ !
+ ! vec(c)
+ DO JL=1,2
+ !
+ ! vec(c)
+ Z_IMAGE_TEMP(JL,1) = -(Z_IMAGE_VECT(JL,2)*Z_NORMA_VECT(3)-Z_IMAGE_VECT(JL,3)*Z_NORMA_VECT(2))
+ Z_IMAGE_TEMP(JL,2) = +(Z_IMAGE_VECT(JL,1)*Z_NORMA_VECT(3)-Z_IMAGE_VECT(JL,3)*Z_NORMA_VECT(1))
+ Z_IMAGE_TEMP(JL,3) = -(Z_IMAGE_VECT(JL,1)*Z_NORMA_VECT(2)-Z_IMAGE_VECT(JL,2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_IMAGE_TEMP(JL,1)**2.+Z_IMAGE_TEMP(JL,2)**2.+Z_IMAGE_TEMP(JL,3)**2.)
+ Z_IMAGE_TEMP(JL,:) = Z_IMAGE_TEMP(JL,:) / Z_NORMA_TEMP
+ !
+ ! vec(t)
+ Z_IMAGE_VECT(JL,1) = +(Z_IMAGE_TEMP(JL,2)*Z_NORMA_VECT(3)-Z_IMAGE_TEMP(JL,3)*Z_NORMA_VECT(2))
+ Z_IMAGE_VECT(JL,2) = -(Z_IMAGE_TEMP(JL,1)*Z_NORMA_VECT(3)-Z_IMAGE_TEMP(JL,3)*Z_NORMA_VECT(1))
+ Z_IMAGE_VECT(JL,3) = +(Z_IMAGE_TEMP(JL,1)*Z_NORMA_VECT(2)-Z_IMAGE_TEMP(JL,2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_IMAGE_VECT(JL,1)**2.+Z_IMAGE_VECT(JL,2)**2.+Z_IMAGE_VECT(JL,3)**2.)
+ Z_IMAGE_VECT(JL,:) = Z_IMAGE_VECT(JL,:) / Z_NORMA_TEMP
+ !
+ ENDDO
+ !
+ IF (HINTERP=='CST') THEN
+ Z_COEFI1 = 1.
+ Z_COEFI2 = 0.
+ ENDIF
+ !
+ IF (HINTERP=='LIN') THEN
+ Z_COEFI1 = 2.
+ Z_COEFI2 =-1.
+ ENDIF
+ !
+ ! (n/t/c) at the interface
+ Z_TANGE_VECT(:) = Z_COEFI1*Z_IMAGE_VECT(1,:)+Z_COEFI2*Z_IMAGE_VECT(2,:)
+ Z_NORMA_TEMP = sqrt(Z_TANGE_VECT(1)**2.+Z_TANGE_VECT(2)**2.+Z_TANGE_VECT(3)**2.)
+ Z_TANGE_VECT(:) = Z_TANGE_VECT(:) / Z_NORMA_TEMP
+ !
+ Z_BINOR_VECT(1) = -(Z_TANGE_VECT(2)*Z_NORMA_VECT(3)-Z_TANGE_VECT(3)*Z_NORMA_VECT(2))
+ Z_BINOR_VECT(2) = +(Z_TANGE_VECT(1)*Z_NORMA_VECT(3)-Z_TANGE_VECT(3)*Z_NORMA_VECT(1))
+ Z_BINOR_VECT(3) = -(Z_TANGE_VECT(1)*Z_NORMA_VECT(2)-Z_TANGE_VECT(2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_BINOR_VECT(1)**2.+Z_BINOR_VECT(2)**2.+Z_BINOR_VECT(3)**2.)
+ Z_BINOR_VECT(:) = Z_BINOR_VECT(:) / Z_NORMA_TEMP
+ !
+ ! matrix
+ PMATRIX(1,1) = Z_NORMA_VECT(1)
+ PMATRIX(1,2) = Z_NORMA_VECT(2)
+ PMATRIX(1,3) = Z_NORMA_VECT(3)
+ PMATRIX(2,1) = Z_TANGE_VECT(1)
+ PMATRIX(2,2) = Z_TANGE_VECT(2)
+ PMATRIX(2,3) = Z_TANGE_VECT(3)
+ PMATRIX(3,1) = Z_BINOR_VECT(1)
+ PMATRIX(3,2) = Z_BINOR_VECT(2)
+ PMATRIX(3,3) = Z_BINOR_VECT(3)
+ !
+ DEALLOCATE(Z_IMAGE_VECT,Z_IMAGE_TEMP)
+ DEALLOCATE(Z_NORMA_VECT,Z_TANGE_VECT,Z_BINOR_VECT)
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUEMAT1
diff --git a/src/MNH/ibm_valuemat2.f90 b/src/MNH/ibm_valuemat2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ba46ba9a89d566a1fdb895d6c95367ca55020b8f
--- /dev/null
+++ b/src/MNH/ibm_valuemat2.f90
@@ -0,0 +1,114 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #########################
+MODULE MODI_IBM_VALUEMAT2
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUEMAT2(PMATRI1) RESULT(PMATRI2)
+ !
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PMATRI1
+ REAL, DIMENSION(3,3) :: PMATRI2
+ !
+ END FUNCTION IBM_VALUEMAT2
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUEMAT2
+!
+! ###############################################
+FUNCTION IBM_VALUEMAT2(PMATRI1) RESULT(PMATRI2)
+ ! ###############################################
+ !
+ !**** *IBM_INTER_VALUEMAT2* - Change of basis (n,t,c) to (u,v,w)
+ !
+ ! PURPOSE
+ ! -------
+ ! Matrix inversion
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:,:), INTENT(IN) :: PMATRI1
+ REAL, DIMENSION(3,3) :: PMATRI2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL
+ REAL :: Z_DETER
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! det(M)
+ Z_DETER = PMATRI1(1,1)*PMATRI1(2,2)*PMATRI1(3,3) + &
+ PMATRI1(1,2)*PMATRI1(2,3)*PMATRI1(3,1) + &
+ PMATRI1(1,3)*PMATRI1(2,1)*PMATRI1(3,2) - &
+ PMATRI1(1,3)*PMATRI1(2,2)*PMATRI1(3,1) - &
+ PMATRI1(2,3)*PMATRI1(3,2)*PMATRI1(1,1) - &
+ PMATRI1(3,3)*PMATRI1(1,2)*PMATRI1(2,1)
+ !
+ ! M^(-1)
+ PMATRI2(1,1) = PMATRI1(2,2)*PMATRI1(3,3)-PMATRI1(2,3)*PMATRI1(3,2)
+ PMATRI2(1,2) = PMATRI1(1,3)*PMATRI1(3,2)-PMATRI1(1,2)*PMATRI1(3,3)
+ PMATRI2(1,3) = PMATRI1(1,2)*PMATRI1(2,3)-PMATRI1(1,3)*PMATRI1(2,2)
+ PMATRI2(2,1) = PMATRI1(2,3)*PMATRI1(3,1)-PMATRI1(2,1)*PMATRI1(3,3)
+ PMATRI2(2,2) = PMATRI1(1,1)*PMATRI1(3,3)-PMATRI1(1,3)*PMATRI1(3,1)
+ PMATRI2(2,3) = PMATRI1(1,3)*PMATRI1(2,1)-PMATRI1(1,1)*PMATRI1(2,3)
+ PMATRI2(3,1) = PMATRI1(2,1)*PMATRI1(3,2)-PMATRI1(2,2)*PMATRI1(3,1)
+ PMATRI2(3,2) = PMATRI1(1,2)*PMATRI1(3,1)-PMATRI1(1,1)*PMATRI1(3,2)
+ PMATRI2(3,3) = PMATRI1(1,1)*PMATRI1(2,2)-PMATRI1(1,2)*PMATRI1(2,1)
+ !
+ PMATRI2(:,:) = PMATRI2(:,:)/Z_DETER
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUEMAT2
diff --git a/src/MNH/ibm_volume.f90 b/src/MNH/ibm_volume.f90
new file mode 100644
index 0000000000000000000000000000000000000000..51d47f44309713a76f890f13c87d2afdfd0fe555
--- /dev/null
+++ b/src/MNH/ibm_volume.f90
@@ -0,0 +1,219 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! ########################
+MODULE MODI_IBM_VOLUME
+ ! ########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_VOLUME(PPHI,PVOL)
+ !
+ REAL, DIMENSION(:,:,:,:) , INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PVOL
+ !
+ END SUBROUTINE IBM_VOLUME
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VOLUME
+!
+! ##################################
+SUBROUTINE IBM_VOLUME(PPHI,PVOL)
+ ! ##################################
+ !
+ !
+ !**** IBM_VOLUME computes surface and volume used in the alteration of the pseudo-equation
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to compute :
+ ! - the surface used in the balance of momentum curvature
+ ! - a volumic fraction deducted from the LS function
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_LBC_n
+ USE MODD_LUNIT_n, ONLY: TLUOUT
+ !
+ ! interface
+ !
+ USE MODI_IBM_INTERPOS
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPHI ! LS functions
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PVOL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: IIE,IIB,IJE,IJB,IKE,IKB
+ INTEGER :: JI,JJ,JK,JL,JM
+ REAL :: ZPH1,ZPH2,ZPH3,ZPH4,ZPH5,ZCOE,ZRAY
+ REAL :: ZPH6,ZPH7,ZPH8,ZDEL,ZPH0,ZBAR,ZVOL
+ REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZXREF,ZYREF,ZZREF
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ !
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(ZXREF(IIU,IJU,IKU))
+ ALLOCATE(ZYREF(IIU,IJU,IKU))
+ ALLOCATE(ZZREF(IIU,IJU,IKU))
+ !
+ ZXREF = 0.
+ ZYREF = 0.
+ ZZREF = 0.
+ !
+ PVOL(:,:,:,:)=0.0
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Volume computations
+ JL = 1
+ PVOL(IIB:IIE,IJB:IJE,IKB:IKE,1:2)=1.
+ !
+ CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,'P')
+ !
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ !
+ ZDEL = ((ZXREF(JI+1,JJ,JK)-ZXREF(JI,JJ,JK))*&
+ (ZYREF(JI,JJ+1,JK)-ZYREF(JI,JJ,JK))*&
+ (ZZREF(JI,JJ,JK+1)-ZZREF(JI,JJ,JK)))**(1./3.)
+ !
+ ZRAY = ZDEL/2.
+ ZCOE = 1./2.
+ ZPH1 = PPHI(JI ,JJ ,JK ,1)
+ !
+ DO JM=1,6
+ !
+ IF (JM==1) ZPH2 = PPHI(JI ,JJ ,JK ,2)
+ IF (JM==2) ZPH2 = PPHI(JI+1,JJ ,JK ,2)
+ IF (JM==3) ZPH2 = PPHI(JI ,JJ ,JK ,3)
+ IF (JM==4) ZPH2 = PPHI(JI ,JJ+1,JK ,3)
+ IF (JM==5) ZPH2 = PPHI(JI ,JJ ,JK ,4)
+ IF (JM==6) ZPH2 = PPHI(JI ,JJ ,JK+1,4)
+ !
+ ZBAR=0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.(XIBM_EPSI)) ZBAR = - ZPH1 / ( ZPH2 - ZPH1 ) * ZDEL * ZCOE
+ !
+ ZBAR=min(ZRAY,ZBAR)
+ ZBAR=max(0.,ZBAR)
+ !
+ PVOL(JI,JJ,JK,1) = -max(0.,+ZPH2/abs(ZPH2))*max(0.,+ZPH1/abs(ZPH1))/6. + PVOL(JI,JJ,JK,1) &
+ -max(0.,-ZPH2*ZPH1/abs(ZPH2*ZPH1))*ABS(max(0.,+ZPH2/abs(ZPH2))-(ZBAR/ZRAY)**3.)/6.
+ !
+ PVOL(JI,JJ,JK,1) = min(1.,PVOL(JI,JJ,JK,1))
+ !
+ ENDDO
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ IF (LWEST_ll ()) PVOL(IIB-1,:,:,1)=PVOL(IIB,:,:,1)
+ IF (LEAST_ll ()) PVOL(IIE+1,:,:,1)=PVOL(IIE,:,:,1)
+ IF (LSOUTH_ll()) PVOL(:,IJB-1,:,1)=PVOL(:,IJB,:,1)
+ IF (LNORTH_ll()) PVOL(:,IJE+1,:,1)=PVOL(:,IJE,:,1)
+ !
+ PVOL(:,:,IKB-1,1)=PVOL(:,:,IKB,1)
+ PVOL(:,:,IKE+1,1)=PVOL(:,:,IKE,1)
+ !
+ IF(LWEST_ll()) THEN
+ PVOL(IIB-1,IJB:IJE,IKB-1,1)=PVOL(IIB-1,IJB:IJE,IKB,1)
+ PVOL(IIB-1,IJB:IJE,IKE+1,1)=PVOL(IIB-1,IJB:IJE,IKE,1)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ PVOL(IIE+1,IJB:IJE,IKB-1,1)=PVOL(IIE+1,IJB:IJE,IKB,1)
+ PVOL(IIE+1,IJB:IJE,IKE+1,1)=PVOL(IIE+1,IJB:IJE,IKE,1)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ PVOL(IIB:IIE,IJB-1,IKB-1,1)=PVOL(IIB:IIE,IJB-1,IKB,1)
+ PVOL(IIB:IIE,IJB-1,IKE+1,1)=PVOL(IIB:IIE,IJB-1,IKE,1)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ PVOL(IIB:IIE,IJE+1,IKB-1,1)=PVOL(IIB:IIE,IJE+1,IKB,1)
+ PVOL(IIB:IIE,IJE+1,IKE+1,1)=PVOL(IIB:IIE,IJE+1,IKE,1)
+ END IF
+ !
+ !**************************************************
+ !
+ WHERE ( PVOL(:,:,:,1).lt.(XIBM_EPSI) ) PVOL(:,:,:,1)=0.
+ WHERE ( PVOL(:,:,:,1).lt.(1.) ) PVOL(:,:,:,2)=0.
+ WHERE ( (PVOL(:,:,:,1)-PVOL(:,:,:,2) ) .GT. 0.0 ) PVOL(:,:,:,3)=1.0
+ !
+ !------------------------------------------------------------------------------
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ DEALLOCATE(ZXREF,ZYREF,ZZREF)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_VOLUME
diff --git a/src/MNH/ini_mean_field.f90 b/src/MNH/ini_mean_field.f90
index e9c5161a9ecec74a65183e26507495ea2f682a3f..43e160cac437e6fe60e8033e3b9978e008cc2610 100644
--- a/src/MNH/ini_mean_field.f90
+++ b/src/MNH/ini_mean_field.f90
@@ -48,6 +48,8 @@ END MODULE MODI_INI_MEAN_FIELD
!! -------------
!! Original 11/12/09
!! 10/2016 (C.Lac) Add max values
+!! 02/2021 (T.Nagel) add passive scalar (XSVT) and UW wind component
+!! 05/2021 (PA.Joulin) add wind turbine variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -75,10 +77,12 @@ XTHM_MEAN = 0.0
XTEMPM_MEAN = 0.0
IF (CTURB /= 'NONE') XTKEM_MEAN = 0.0
XPABSM_MEAN = 0.0
+XSVT_MEAN = 0.0
!
XU2_MEAN = 0.0
XV2_MEAN = 0.0
XW2_MEAN = 0.0
+XUW_MEAN = 0.0
XTH2_MEAN = 0.0
XTEMP2_MEAN = 0.0
XPABS2_MEAN = 0.0
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index d0020427d3cf464100a77eef071724aa4fd326d0..ef474931a1d41fac0bdb41bd9cc2506cce4976f3 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -290,6 +290,8 @@ END MODULE MODI_INI_MODEL_n
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! S. Riette 04/2020: XHL* fields
+! F. Auguste 02/2021: add IBM
+! T.Nigel 02/2021: add turbulence recycling
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -303,6 +305,7 @@ USE MODD_2D_FRC
USE MODD_ADVFRC_n
USE MODD_ADV_n
use MODD_AEROSET, only: POLYTAU, POLYSSA, POLYG
+USE MODD_ALLSTATION_n
USE MODD_ARGSLIST_ll, only: LIST_ll
USE MODD_BIKHARDT_n
USE MODD_BLOWSNOW
@@ -351,6 +354,7 @@ USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID_n
USE MODD_GRID, only: XLONORI,XLATORI
+USE MODD_IBM_PARAM_n !ONLY: LIBM, XIBM_LS, XIBM_IEPS
USE MODD_IO, only: CIO_DIR, TFILEDATA, TFILE_DUMMY
USE MODD_IO_SURF_MNH, only: IO_SURF_MNH_MODEL
USE MODD_LATZ_EDFLX
@@ -377,6 +381,7 @@ USE MODD_PASPOL_n
USE MODD_PAST_FIELD_n
use modd_precision, only: LFIINT
USE MODD_RADIATIONS_n
+USE MODD_RECYCL_PARAM_n
USE MODD_REF
USE MODD_REF_n
USE MODD_RELFRC_n
@@ -388,6 +393,7 @@ use MODD_SALT_OPT_LKT, only: NMAX_RADIUS_LKT_SALT=>NMAX_RADIUS_LKT, NMAX_SI
USE MODD_SERIES, only: LSERIES
USE MODD_SHADOWS_n
USE MODD_STAND_ATM, only: XSTROATM, XSMLSATM, XSMLWATM, XSPOSATM, XSPOWATM
+USE MODD_STATION_n
USE MODD_TIME
USE MODD_TIME_n
USE MODD_TURB_CLOUD, only: NMODEL_CLOUD, CTURBLEN_CLOUD,XCEI
@@ -517,6 +523,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSRAD ! surface temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_LS ! LevelSet IBM
!
!
INTEGER, DIMENSION(:,:),ALLOCATABLE :: IINDEX ! indices of non-zero terms
@@ -699,6 +706,27 @@ CALL UPDATE_NSV(KMI)
!
!* 3. ALLOCATE MEMORY
! -----------------
+! * Module RECYCL
+!
+IF (LRECYCL) THEN
+!
+ R_COUNT = 0
+!
+ ALLOCATE(XUMEANW(IJU,IKU,INT(XNUMBELT))) ; XUMEANW = 0.0
+ ALLOCATE(XVMEANW(IJU,IKU,INT(XNUMBELT))) ; XVMEANW = 0.0
+ ALLOCATE(XWMEANW(IJU,IKU,INT(XNUMBELT))) ; XWMEANW = 0.0
+ ALLOCATE(XUMEANN(IIU,IKU,INT(XNUMBELT))) ; XUMEANN = 0.0
+ ALLOCATE(XVMEANN(IIU,IKU,INT(XNUMBELT))) ; XVMEANN = 0.0
+ ALLOCATE(XWMEANN(IIU,IKU,INT(XNUMBELT))) ; XWMEANN = 0.0
+ ALLOCATE(XUMEANE(IJU,IKU,INT(XNUMBELT))) ; XUMEANE = 0.0
+ ALLOCATE(XVMEANE(IJU,IKU,INT(XNUMBELT))) ; XVMEANE = 0.0
+ ALLOCATE(XWMEANE(IJU,IKU,INT(XNUMBELT))) ; XWMEANE = 0.0
+ ALLOCATE(XUMEANS(IIU,IKU,INT(XNUMBELT))) ; XUMEANS = 0.0
+ ALLOCATE(XVMEANS(IIU,IKU,INT(XNUMBELT))) ; XVMEANS = 0.0
+ ALLOCATE(XWMEANS(IIU,IKU,INT(XNUMBELT))) ; XWMEANS = 0.0
+ ALLOCATE(XTBV(IIU,IJU,IKU)) ; XTBV = 0.0
+END IF
+!
!
!* 3.1 Module MODD_FIELD_n
!
@@ -711,6 +739,7 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XWM_MEAN(IIU,IJU,IKU)) ; XWM_MEAN = 0.0
ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0
ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0
+ ALLOCATE(XSVT_MEAN(IIU,IJU,IKU)) ; XSVT_MEAN = 0.0
IF (CTURB/='NONE') THEN
ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
XTKEM_MEAN = 0.0
@@ -722,6 +751,7 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XU2_MEAN(IIU,IJU,IKU)) ; XU2_MEAN = 0.0
ALLOCATE(XV2_MEAN(IIU,IJU,IKU)) ; XV2_MEAN = 0.0
ALLOCATE(XW2_MEAN(IIU,IJU,IKU)) ; XW2_MEAN = 0.0
+ ALLOCATE(XUW_MEAN(IIU,IJU,IKU)) ; XUW_MEAN = 0.0
ALLOCATE(XTH2_MEAN(IIU,IJU,IKU)) ; XTH2_MEAN = 0.0
ALLOCATE(XTEMP2_MEAN(IIU,IJU,IKU)) ; XTEMP2_MEAN = 0.0
ALLOCATE(XPABS2_MEAN(IIU,IJU,IKU)) ; XPABS2_MEAN = 0.0
@@ -799,6 +829,21 @@ ALLOCATE(XRVS_PRES(IIU,IJU,IKU)); XRVS_PRES = 0.0
ALLOCATE(XRWS_PRES(IIU,IJU,IKU)); XRWS_PRES = 0.0
ALLOCATE(XRTHS(IIU,IJU,IKU)) ; XRTHS = 0.0
ALLOCATE(XRTHS_CLD(IIU,IJU,IKU)); XRTHS_CLD = 0.0
+ALLOCATE(ZIBM_LS(IIU,IJU,IKU)) ; ZIBM_LS = 0.0
+ALLOCATE(XIBM_XMUT(IIU,IJU,IKU)); XIBM_XMUT = 0.0
+ALLOCATE(XFLUCTUNW(IJU,IKU)) ; XFLUCTUNW = 0.0
+ALLOCATE(XFLUCTVNN(IIU,IKU)) ; XFLUCTVNN = 0.0
+ALLOCATE(XFLUCTUTN(IIU,IKU)) ; XFLUCTUTN = 0.0
+ALLOCATE(XFLUCTVTW(IJU,IKU)) ; XFLUCTVTW = 0.0
+ALLOCATE(XFLUCTUNE(IJU,IKU)) ; XFLUCTUNE = 0.0
+ALLOCATE(XFLUCTVNS(IIU,IKU)) ; XFLUCTVNS = 0.0
+ALLOCATE(XFLUCTUTS(IIU,IKU)) ; XFLUCTUTS = 0.0
+ALLOCATE(XFLUCTVTE(IJU,IKU)) ; XFLUCTVTE = 0.0
+ALLOCATE(XFLUCTWTW(IJU,IKU)) ; XFLUCTWTW = 0.0
+ALLOCATE(XFLUCTWTN(IIU,IKU)) ; XFLUCTWTN = 0.0
+ALLOCATE(XFLUCTWTE(IJU,IKU)) ; XFLUCTWTE = 0.0
+ALLOCATE(XFLUCTWTS(IIU,IKU)) ; XFLUCTWTS = 0.0
+!
IF (CTURB /= 'NONE') THEN
ALLOCATE(XTKET(IIU,IJU,IKU))
ALLOCATE(XRTKES(IIU,IJU,IKU))
@@ -1808,7 +1853,10 @@ CALL READ_FIELD(TPINIFILE,IIU,IJU,IKU, &
NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
- XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD )
+ XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD, &
+ ZIBM_LS,XIBM_XMUT,XUMEANW,XVMEANW,XWMEANW,XUMEANN,XVMEANN, &
+ XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS )
+
!
!-------------------------------------------------------------------------------
!
@@ -2100,6 +2148,13 @@ CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
IF (LDRAG) THEN
CALL INI_DRAG(LMOUNT,XZS,XHSTART,NSTART,XDRAG)
ENDIF
+!* 16.2 Initialize the LevelSet function
+! -------------
+IF (LIBM) THEN
+ ALLOCATE(XIBM_LS(IIU,IJU,IKU,4)) ; XIBM_LS = -XIBM_IEPS
+ XIBM_LS(:,:,:,1)=ZIBM_LS(:,:,:)
+ DEALLOCATE(ZIBM_LS)
+ENDIF
!-------------------------------------------------------------------------------
!
!* 17. SURFACE FIELDS
@@ -2431,7 +2486,7 @@ CALL INI_AIRCRAFT_BALLOON(TPINIFILE,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
! -----------------------
!
CALL INI_SURFSTATION_n(XTSTEP, XSEGLEN, NRR, NSV, &
- CTURB=="TKEL" , &
+ CTURB=="TKEL" , KMI, &
XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ini_stationn.f90 b/src/MNH/ini_stationn.f90
index ea90fed1e128870ed60fac373163ea75c2fe674d..c113b737757516b2772304c7f26396a3796c2dff 100644
--- a/src/MNH/ini_stationn.f90
+++ b/src/MNH/ini_stationn.f90
@@ -22,7 +22,7 @@
!!** METHOD
!! ------
!!
-!! Must be defined (for each aircraft):
+!! Must be defined (for each station):
!! ---------------
!!
!! No default exist for these variables.
@@ -37,7 +37,7 @@
!!
!!
!!
-!! Can be defined (for each aircraft):
+!! Can be defined (for each station):
!! --------------
!!
!!
@@ -64,14 +64,18 @@
!! MODIFICATIONS
!! -------------
!! Original 15/01/2002
+!! Modification: 02/2021 (E.Jezequel) Read stations from CVS file
!!
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_STATION_n
+USE MODD_ALLSTATION_n
USE MODD_PARAMETERS
+!USE MODN_STATION_n
+USE MODD_CONF, ONLY: LCARTESIAN
+USE MODI_STATION_READER
!
!
IMPLICIT NONE
@@ -84,68 +88,62 @@ IMPLICIT NONE
!
! 0.2 declaration of local variables
!
+INTEGER :: JI
!
!----------------------------------------------------------------------------
!
!* 1. Nameliste
! ---------
-NUMBSTAT = 0
-!
-IF (NUMBSTAT > 0) THEN
-ALLOCATE (TSTATION%LAT(NUMBSTAT))
-ALLOCATE (TSTATION%LON(NUMBSTAT))
-ALLOCATE (TSTATION%I(NUMBSTAT))
-ALLOCATE (TSTATION%J(NUMBSTAT))
-ALLOCATE (TSTATION%Z(NUMBSTAT))
-ALLOCATE (TSTATION%K(NUMBSTAT))
-ALLOCATE (TSTATION%NAME(NUMBSTAT))
-ALLOCATE (TSTATION%TYPE(NUMBSTAT))
-!
-TSTATION%LON = XUNDEF
-TSTATION%LAT = XUNDEF
-TSTATION%Z = XUNDEF
-TSTATION%K = XUNDEF
-TSTATION%I = XUNDEF
-TSTATION%J = XUNDEF
-TSTATION%NAME = " "
-TSTATION%TYPE = " "
-!
-TSTATION%STEP = 10.
-!
-!* location (latitude, longitude, altitude)
-!
-!***************************************************************
-! * Horizontal location
-! You have to choose between (TSTATION%LAT,TSTATION%LON)
-! or (TSTATION%I,TSTATION%J) for all the stations
-! if both are defined it will choose (TSTATION%LAT,TSTATION%LON)
-!***************************************************************
-!
-!TSTATION%LAT = (/ 45.0 /)
-!TSTATION%LON = (/ 4.5 /)
-TSTATION%I = (/ 25 /)
-TSTATION%J = (/ 20 /)
-!
-!***************************************************************
-! * Vertical location
-! You have to choose between TSTATION%K and TSTATION%Z
-! for all the stations
-! if both are defined it will choose TSTATION%K
-!***************************************************************
-!TSTATION%Z = (/ 10., 500. /)
-!
-TSTATION%K = (/ 10 /)
-!
-!***************************************************************
-!* station name
-!***************************************************************
-TSTATION%NAME = (/ 'BIDON' /)
-!***************************************************************
-!* station type
-!***************************************************************
-TSTATION%TYPE = (/ 'sol '/)
-!
-!----------------------------------------------------------------------------
-ENDIF
+
+IF (CFILE_STAT=="NO_INPUT_CSV") THEN
+ NUMBSTAT = NNUMB_STAT
+
+ IF (NUMBSTAT > 0) THEN
+ ALLOCATE (TSTATION%LAT(NUMBSTAT))
+ ALLOCATE (TSTATION%LON(NUMBSTAT))
+ ALLOCATE (TSTATION%X(NUMBSTAT))
+ ALLOCATE (TSTATION%Y(NUMBSTAT))
+ ALLOCATE (TSTATION%Z(NUMBSTAT))
+ ALLOCATE (TSTATION%K(NUMBSTAT))
+ ALLOCATE (TSTATION%NAME(NUMBSTAT))
+ ALLOCATE (TSTATION%TYPE(NUMBSTAT))
+ !
+ TSTATION%LON = XUNDEF
+ TSTATION%LAT = XUNDEF
+ TSTATION%Z = XUNDEF
+ TSTATION%K = XUNDEF
+ TSTATION%X = XUNDEF
+ TSTATION%Y = XUNDEF
+ TSTATION%NAME = " "
+ TSTATION%TYPE = " "
+ !
+ TSTATION%STEP = XSTEP_STAT
+ !
+ IF (LCARTESIAN) THEN
+ DO JI=1,NUMBSTAT
+ TSTATION%X(JI)= XX_STAT(JI)
+ TSTATION%Y(JI)= XY_STAT(JI)
+ TSTATION%Z(JI)= XZ_STAT(JI)
+ TSTATION%NAME(JI)= CNAME_STAT(JI)
+ TSTATION%TYPE(JI)= CTYPE_STAT(JI)
+ END DO
+ ELSE
+ DO JI=1,NUMBSTAT
+ TSTATION%LAT(JI)= XLAT_STAT(JI)
+ TSTATION%LON(JI)= XLON_STAT(JI)
+ TSTATION%Z(JI)= XZ_STAT(JI)
+ TSTATION%NAME(JI)= CNAME_STAT(JI)
+ TSTATION%TYPE(JI)= CTYPE_STAT(JI)
+ END DO
+ ENDIF
+ ENDIF
+ELSE
+!
+!* 2. CSV DATA
+!
+ CALL READ_CSV_STATION(90,CFILE_STAT,TSTATION,LCARTESIAN)
+ TSTATION%STEP = XSTEP_STAT
+END IF
+
!
END SUBROUTINE INI_STATION_n
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index bf6f4799317ca1adf9dc464a28cca5a311da940a..bd426e204e99fb394b3c6320ee8292dc60916192 100644
--- a/src/MNH/ini_surfstationn.f90
+++ b/src/MNH/ini_surfstationn.f90
@@ -10,7 +10,7 @@ MODULE MODI_INI_SURFSTATION_n
INTERFACE
!
SUBROUTINE INI_SURFSTATION_n(PTSTEP, PSEGLEN, &
- KRR, KSV, OUSETKE, &
+ KRR, KSV, OUSETKE, KMI, &
PLATOR, PLONOR )
!
USE MODD_TYPE_DATE
@@ -21,6 +21,7 @@ INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
+INTEGER, INTENT(IN) :: KMI ! MODEL NUMBER
!
!-------------------------------------------------------------------------------
!
@@ -32,7 +33,7 @@ END MODULE MODI_INI_SURFSTATION_n
!
! ########################################################
SUBROUTINE INI_SURFSTATION_n(PTSTEP, PSEGLEN, &
- KRR, KSV, OUSETKE, &
+ KRR, KSV, OUSETKE, KMI, &
PLATOR, PLONOR )
! ########################################################
!
@@ -66,7 +67,8 @@ END MODULE MODI_INI_SURFSTATION_n
!! A. Lemonsu 19/11/2002
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! R. Schoetter 11/2019: work for cartesian coordinates + parallel.
+! R. Schoetter 11/2019: work for cartesian coordinates + parallel.
+! E.Jezequel 02/2021: Read stations from CVS file
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -80,9 +82,11 @@ USE MODD_GRID_n
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
USE MODD_SHADOWS_n
+USE MODD_ALLSTATION_n
USE MODD_STATION_n
USE MODD_TYPE_DATE
USE MODD_VAR_ll, ONLY: IP
+USE MODD_NESTING
!
USE MODE_GATHER_ll
USE MODE_GRIDPROJ
@@ -90,6 +94,7 @@ USE MODE_ll
USE MODE_MSG
!
USE MODI_INI_STATION_N
+!USE MODN_STATION_n
!
IMPLICIT NONE
!
@@ -104,6 +109,7 @@ INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
+INTEGER, INTENT(IN) :: KMI ! MODEL NUMBER
!
!-------------------------------------------------------------------------------
!
@@ -135,8 +141,8 @@ LSTATION = (NUMBSTAT>0)
! -----------------------------
!
IF(NUMBSTAT>0) THEN
- CALL ALLOCATE_STATION_n(TSTATION)
- CALL INI_INTERP_STATION_n(TSTATION)
+ CALL ALLOCATE_STATION_n(TSTATION,KMI)
+ IF (.NOT. LCARTESIAN) CALL INI_INTERP_STATION_n(TSTATION)
ENDIF
!----------------------------------------------------------------------------
!
@@ -156,21 +162,26 @@ TSTATION%STEP = XTSTEP
END SUBROUTINE DEFAULT_STATION_n
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-SUBROUTINE ALLOCATE_STATION_n(TSTATION)
+SUBROUTINE ALLOCATE_STATION_n(TSTATION,KMI)
!
TYPE(STATION), INTENT(INOUT) :: TSTATION !
-
+INTEGER :: KMI ! Model Index
+!
if ( tstation%step < xtstep ) then
call Print_msg( NVERB_ERROR, 'GEN', 'INI_SURFSTATION_n', 'TSTATION%STEP smaller than XTSTEP' )
tstation%step = xtstep
end if
-ISTORE = INT ( (PSEGLEN-XTSTEP) / TSTATION%STEP ) + 1
+IF (KMI==1) THEN
+ ISTORE = NINT ( (PSEGLEN-XTSTEP) / TSTATION%STEP ) + 1
+ELSE
+ ISTORE = NINT ( (PSEGLEN-XTSTEP * NDTRATIO(KMI)) / TSTATION%STEP ) + 1
+END IF
allocate( tstation%tpdates( istore ) )
ALLOCATE(TSTATION%ERROR (NUMBSTAT))
-ALLOCATE(TSTATION%X (NUMBSTAT))
-ALLOCATE(TSTATION%Y (NUMBSTAT))
+!ALLOCATE(TSTATION%X (NUMBSTAT))
+!ALLOCATE(TSTATION%Y (NUMBSTAT))
ALLOCATE(TSTATION%SV (ISTORE,NUMBSTAT,KSV))
ALLOCATE(TSTATION%TSRAD (ISTORE,NUMBSTAT))
ALLOCATE(TSTATION%ZS (NUMBSTAT))
@@ -251,27 +262,7 @@ IF ( ALL(TSTATION%LAT(:)/=XUNDEF) .AND. ALL(TSTATION%LON(:)/=XUNDEF) ) THEN
TSTATION%X(JII), TSTATION%Y(JII) )
ENDDO
ELSE
- DO JII=1,NUMBSTAT
- CALL GET_DIM_EXT_ll ('B',IIU,IJU)
- IIU_ll=NIMAX_ll + 2 * JPHEXT
- IJU_ll=NJMAX_ll + 2 * JPHEXT
- ALLOCATE(XXHAT_ll (IIU_ll))
- ALLOCATE(XYHAT_ll (IJU_ll))
- !
- CALL GATHERALL_FIELD_ll('XX',XXHAT,XXHAT_ll,IRESP)
- CALL GATHERALL_FIELD_ll('YY',XYHAT,XYHAT_ll,IRESP)
- TSTATION%X(JII) = XXHAT_ll(TSTATION%I(JII))
- TSTATION%Y(JII) = XYHAT_ll(TSTATION%J(JII))
- IF (LCARTESIAN) THEN
- XRPK = -1
- ENDIF
- CALL SM_LATLON(PLATOR,PLONOR, &
- TSTATION%X(JII), TSTATION%Y(JII), &
- TSTATION%LAT(JII), TSTATION%LON(JII) )
- ENDDO
-END IF
!
-IF ( ANY(TSTATION%LAT(:)==XUNDEF) .OR. ANY(TSTATION%LON(:)==XUNDEF) ) THEN
WRITE(ILUOUT,*) 'Error in station position '
WRITE(ILUOUT,*) 'either LATitude or LONgitude segment'
WRITE(ILUOUT,*) 'or I and J segment'
diff --git a/src/MNH/mean_field.f90 b/src/MNH/mean_field.f90
index 9ff392a18aa9940e7fcd1268cf923007366ae40a..bc4b216721af44735825835eefa96024370bef0a 100644
--- a/src/MNH/mean_field.f90
+++ b/src/MNH/mean_field.f90
@@ -10,11 +10,13 @@
!
INTERFACE
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
+ SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST,PSVT)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT ! Passive scalar variables
+
END SUBROUTINE MEAN_FIELD
END INTERFACE
@@ -22,7 +24,7 @@ END INTERFACE
END MODULE MODI_MEAN_FIELD
!
! #######################################################
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
+ SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST,PSVT)
! #######################################################
!
!!**** *MEAN_FIELD * -
@@ -57,6 +59,7 @@ USE MODD_MEAN_FIELD_n
USE MODD_PARAM_n
USE MODD_MEAN_FIELD
USE MODD_CST
+USE MODD_PASPOL
!
USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTORQT, XPOWT
@@ -72,6 +75,8 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT
+
!
!* 0.2 Declarations of local variables :
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZTEMPT
@@ -103,12 +108,14 @@ IKE=IKU-JPVEXT
XWM_MEAN = PWT + XWM_MEAN
XTHM_MEAN = PTHT + XTHM_MEAN
XTEMPM_MEAN = ZTEMPT + XTEMPM_MEAN
+ IF (LPASPOL) XSVT_MEAN = PSVT + XSVT_MEAN
IF (CTURB/='NONE') XTKEM_MEAN = PTKET + XTKEM_MEAN
XPABSM_MEAN = PPABST + XPABSM_MEAN
!
XU2_MEAN = PUT**2 + XU2_MEAN
XV2_MEAN = PVT**2 + XV2_MEAN
XW2_MEAN = PWT**2 + XW2_MEAN
+ XUW_MEAN = PUT*PWT + XUW_MEAN
XTH2_MEAN = PTHT**2 + XTH2_MEAN
XTEMP2_MEAN = ZTEMPT**2 + XTEMP2_MEAN
XPABS2_MEAN = PPABST**2 + XPABS2_MEAN
diff --git a/src/MNH/modd_allstationn.f90 b/src/MNH/modd_allstationn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2b1d9d37c79a14ce86c3d9d50713cccc0301d636
--- /dev/null
+++ b/src/MNH/modd_allstationn.f90
@@ -0,0 +1,93 @@
+!MNH_LIC Copyright 1994-2021 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.
+!-----------------------------------------------------------------
+! ############################
+ MODULE MODD_ALLSTATION_n
+! ############################
+!
+!!**** *MODD_STATION* - declaration of stations
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to define
+! the different stations types.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! E. Jezequel *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/06/21
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_TYPE_STATION
+USE MODD_STATION_n
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE ALLSTATION_t
+!
+!-------------------------------------------------------------------------------------------
+!
+!
+ INTEGER :: NNUMB_STAT !Number of stations as defined in namelist
+ REAL, DIMENSION(100) :: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+ CHARACTER(LEN=7), DIMENSION(100) :: CNAME_STAT, CTYPE_STAT
+ CHARACTER(LEN=20) :: CFILE_STAT
+ REAL :: XSTEP_STAT
+ LOGICAL :: LDIAG_RESULTS
+ !
+!
+END TYPE ALLSTATION_t
+
+TYPE(ALLSTATION_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: ALLSTATION_MODEL
+
+INTEGER, POINTER :: NNUMB_STAT=>NULL()
+REAL, POINTER :: XSTEP_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XX_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XY_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XLAT_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XLON_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XZ_STAT=>NULL()
+CHARACTER (LEN=7),DIMENSION(:), POINTER :: CNAME_STAT=>NULL()
+CHARACTER (LEN=7),DIMENSION(:), POINTER :: CTYPE_STAT=>NULL()
+CHARACTER (LEN=20),POINTER :: CFILE_STAT=>NULL()
+LOGICAL, POINTER :: LDIAG_RESULTS=>NULL()
+CONTAINS
+
+SUBROUTINE ALLSTATION_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+!
+! Current model is set to model KTO
+
+NNUMB_STAT =>ALLSTATION_MODEL(KTO)%NNUMB_STAT
+XSTEP_STAT =>ALLSTATION_MODEL(KTO)%XSTEP_STAT
+XX_STAT =>ALLSTATION_MODEL(KTO)%XX_STAT
+XY_STAT =>ALLSTATION_MODEL(KTO)%XY_STAT
+XZ_STAT =>ALLSTATION_MODEL(KTO)%XZ_STAT
+XLAT_STAT =>ALLSTATION_MODEL(KTO)%XLAT_STAT
+XLON_STAT =>ALLSTATION_MODEL(KTO)%XLON_STAT
+CNAME_STAT =>ALLSTATION_MODEL(KTO)%CNAME_STAT
+CTYPE_STAT =>ALLSTATION_MODEL(KTO)%CTYPE_STAT
+CFILE_STAT =>ALLSTATION_MODEL(KTO)%CFILE_STAT
+LDIAG_RESULTS =>ALLSTATION_MODEL(KTO)%LDIAG_RESULTS
+END SUBROUTINE ALLSTATION_GOTO_MODEL
+
+END MODULE MODD_ALLSTATION_n
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 32ba30187b2412c5cd67220c1feeb3ee98ecf3e5..278e98521a4003cfa3a23441215d9db422739962 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -54,6 +54,7 @@
! P. Wautelet 06/03/2019: correct XZWS entry
! P. Wautelet 14/03/2019: add XZWS_DEFAULT parameter
! 04/2020 S. Riette HighLow cloud
+!! 02/2021 (T.Nagel) Add fields for turbulence recycling
!!
!-------------------------------------------------------------------------------
!
@@ -111,6 +112,18 @@ TYPE FIELD_t
REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL() ! Theta at Previous time step
REAL, DIMENSION(:,:,:), POINTER :: XRCM=>NULL() ! Cloud mixing ratio at Previous time step
REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL() ! Theta at Previous time step
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUNW=>NULL() !U normal velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVTW=>NULL() !V tangential velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVNN=>NULL() !V normal velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUTN=>NULL() !U tangential velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUNE=>NULL() !U normal velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVTE=>NULL() !V tangential velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVNS=>NULL() !V normal velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUTS=>NULL() !U tangential velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTW=>NULL() !W tangential velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTN=>NULL() !W tangential velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTE=>NULL() !W tangential velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTS=>NULL() !W tangential velocity fluctuations SOUTH boundary
!
END TYPE FIELD_t
@@ -151,7 +164,9 @@ REAL, DIMENSION(:,:,:), POINTER :: XCIT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRCM=>NULL()
-
+REAL, DIMENSION(:,:), POINTER :: XFLUCTUNW=>NULL(),XFLUCTVNN=>NULL(),XFLUCTUTN=>NULL(),XFLUCTVTW=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFLUCTUNE=>NULL(),XFLUCTVNS=>NULL(),XFLUCTUTS=>NULL(),XFLUCTVTE=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFLUCTWTW=>NULL(),XFLUCTWTN=>NULL(),XFLUCTWTE=>NULL(),XFLUCTWTS=>NULL()
CONTAINS
SUBROUTINE FIELD_GOTO_MODEL(KFROM, KTO)
@@ -195,6 +210,18 @@ FIELD_MODEL(KFROM)%XSRC=>XSRC
FIELD_MODEL(KFROM)%XTHM=>XTHM
FIELD_MODEL(KFROM)%XPABSM=>XPABSM
FIELD_MODEL(KFROM)%XRCM=>XRCM
+FIELD_MODEL(KFROM)%XFLUCTUNW=>XFLUCTUNW
+FIELD_MODEL(KFROM)%XFLUCTVNN=>XFLUCTVNN
+FIELD_MODEL(KFROM)%XFLUCTUTN=>XFLUCTUTN
+FIELD_MODEL(KFROM)%XFLUCTVTW=>XFLUCTVTW
+FIELD_MODEL(KFROM)%XFLUCTUNE=>XFLUCTUNE
+FIELD_MODEL(KFROM)%XFLUCTVNS=>XFLUCTVNS
+FIELD_MODEL(KFROM)%XFLUCTUTS=>XFLUCTUTS
+FIELD_MODEL(KFROM)%XFLUCTVTE=>XFLUCTVTE
+FIELD_MODEL(KFROM)%XFLUCTWTW=>XFLUCTWTW
+FIELD_MODEL(KFROM)%XFLUCTWTN=>XFLUCTWTN
+FIELD_MODEL(KFROM)%XFLUCTWTE=>XFLUCTWTE
+FIELD_MODEL(KFROM)%XFLUCTWTS=>XFLUCTWTS
!
! Current model is set to model KTO
!XZWS=>FIELD_MODEL(KTO)%XZWS !Done in FIELDLIST_GOTO_MODEL
@@ -233,7 +260,18 @@ XSRC=>FIELD_MODEL(KTO)%XSRC
XTHM=>FIELD_MODEL(KTO)%XTHM
XPABSM=>FIELD_MODEL(KTO)%XPABSM
XRCM=>FIELD_MODEL(KTO)%XRCM
-
+XFLUCTUNW=>FIELD_MODEL(KTO)%XFLUCTUNW
+XFLUCTVNN=>FIELD_MODEL(KTO)%XFLUCTVNN
+XFLUCTUTN=>FIELD_MODEL(KTO)%XFLUCTUTN
+XFLUCTVTW=>FIELD_MODEL(KTO)%XFLUCTVTW
+XFLUCTUNE=>FIELD_MODEL(KTO)%XFLUCTUNE
+XFLUCTVNS=>FIELD_MODEL(KTO)%XFLUCTVNS
+XFLUCTUTS=>FIELD_MODEL(KTO)%XFLUCTUTS
+XFLUCTVTE=>FIELD_MODEL(KTO)%XFLUCTVTE
+XFLUCTWTW=>FIELD_MODEL(KTO)%XFLUCTWTW
+XFLUCTWTN=>FIELD_MODEL(KTO)%XFLUCTWTN
+XFLUCTWTE=>FIELD_MODEL(KTO)%XFLUCTWTE
+XFLUCTWTS=>FIELD_MODEL(KTO)%XFLUCTWTS
END SUBROUTINE FIELD_GOTO_MODEL
END MODULE MODD_FIELD_n
diff --git a/src/MNH/modd_ibm_lsf.f90 b/src/MNH/modd_ibm_lsf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..94f899a7ff572ca9ffda7fb6877c41ea1a91f48a
--- /dev/null
+++ b/src/MNH/modd_ibm_lsf.f90
@@ -0,0 +1,77 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODD_IBM_LSF
+ ! #######################
+ !
+ !!**** MODD_IBM_LSF_ - declaration of the control parameters
+ !! used in the LSF building
+ !!
+ !! PURPOSE
+ !! -------
+ !!**** The purpose of this declarative module is to declare the constants
+ !! which allow to initialize the embedded fluid-solid interface
+ !!
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !! None
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste (CERFACS-AE)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ USE MODD_PARAMETERS, ONLY: JPMODELMAX
+ !
+ IMPLICIT NONE
+ !
+ TYPE LSF_t
+ !
+ LOGICAL :: LIBM_LSF = .FALSE. ! IBM logical
+ CHARACTER(LEN=4) :: CIBM_TYPE = 'NONE' ! switch generalized/idealized surface
+ INTEGER :: NIBM_SMOOTH = 1 ! smooth levels for LS
+ REAL :: XIBM_SMOOTH = 0.0001 ! smooth weighting
+ !
+ END TYPE LSF_t
+ !
+ TYPE(LSF_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: LSF_MODEL
+ !
+ LOGICAL , POINTER :: LIBM_LSF=>NULL()
+ CHARACTER(LEN=4) , POINTER :: CIBM_TYPE=>NULL()
+ INTEGER , POINTER :: NIBM_SMOOTH=>NULL()
+ REAL , POINTER :: XIBM_SMOOTH=>NULL()
+ !
+CONTAINS
+ !
+ SUBROUTINE LSF_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ ! Save current state for allocated arrays
+ !
+ ! Current model is set to model KTO
+ LIBM_LSF=>LSF_MODEL(KTO)%LIBM_LSF
+ CIBM_TYPE=>LSF_MODEL(KTO)%CIBM_TYPE
+ XIBM_SMOOTH=>LSF_MODEL(KTO)%XIBM_SMOOTH
+ NIBM_SMOOTH=>LSF_MODEL(KTO)%NIBM_SMOOTH
+ !
+ END SUBROUTINE LSF_GOTO_MODEL
+ !
+END MODULE MODD_IBM_LSF
+!
+
diff --git a/src/MNH/modd_ibm_paramn.f90 b/src/MNH/modd_ibm_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..87899fe69c4297d53698508bd7be261c43aff4ff
--- /dev/null
+++ b/src/MNH/modd_ibm_paramn.f90
@@ -0,0 +1,324 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+MODULE MODD_IBM_PARAM_n
+ ! #######################
+ !
+ !**** MODD_IBM_PARAM_n - declaration of the control parameters
+ ! used in the immersed boundary method
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this declarative module is to declare the constants
+ ! which allow to initialize the embedded surface
+ !
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! None
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !----------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ USE MODD_PARAMETERS, ONLY: JPMODELMAX
+ IMPLICIT NONE
+ !
+ TYPE IBM_t
+ !
+ LOGICAL :: LIBM,LIBM_TROUBLE ! IBM logical
+ CHARACTER(LEN=6) :: CIBM_ADV ! GCT switch
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S ! 1D interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S ! 3D interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E
+ REAL :: XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S ! Boundary interpolation type
+ REAL :: XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V ! BI type (velocity)
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V
+ REAL :: XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V
+ REAL :: XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S ! radius of IDW,MDW
+ REAL :: XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V
+ REAL :: XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S ! power of IDW,MDW
+ REAL :: XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+ INTEGER :: NIBM_LAYER_V,NIBM_LAYER_T,NIBM_LAYER_P,NIBM_LAYER_R ! layers number in each type
+ INTEGER :: NIBM_LAYER_E,NIBM_LAYER_Q,NIBM_LAYER_S
+ INTEGER :: NIBM_ITR ! maximum iteration in pressure solver
+ REAL :: XIBM_RUG ,XIBM_VISC, XIBM_CNU ! physical parameters for wall model
+ REAL :: XIBM_EPSI ! min truncation parameters
+ REAL :: XIBM_IEPS ! max truncation parameters
+ !
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_XMUT=>NULL() ! turbulent viscosity
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_CURV=>NULL() ! parameter for interface curvature
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_LS=>NULL() ! LSF for MNH
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SU=>NULL() ! volume fraction based on LSF
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SUTR=>NULL() ! volume fraction based on LSF if trouble
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_P=>NULL() ! Ghosts,Images location/Index
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:), POINTER :: NIBM_IMAGE_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:), POINTER :: NIBM_IMAGE_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_V=>NULL()
+ !
+ END TYPE IBM_t
+ !
+ TYPE(IBM_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: IBM_MODEL
+ !
+ LOGICAL , POINTER :: LIBM=>NULL()
+ LOGICAL , POINTER :: LIBM_TROUBLE=>NULL()
+ CHARACTER(LEN=6), POINTER :: CIBM_ADV=>NULL()
+ REAL , POINTER :: XIBM_EPSI=>NULL()
+ REAL , POINTER :: XIBM_IEPS=>NULL()
+ INTEGER , POINTER :: NIBM_ITR=>NULL()
+ !
+ INTEGER, POINTER :: NIBM_LAYER_P=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_Q=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_R=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_S=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_T=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_V=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_E=>NULL()
+ !
+ REAL, POINTER :: XIBM_RADIUS_P=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_Q=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_R=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_S=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_T=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_E=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_V=>NULL()
+ REAL, POINTER :: XIBM_POWERS_P=>NULL()
+ REAL, POINTER :: XIBM_POWERS_Q=>NULL()
+ REAL, POINTER :: XIBM_POWERS_R=>NULL()
+ REAL, POINTER :: XIBM_POWERS_S=>NULL()
+ REAL, POINTER :: XIBM_POWERS_T=>NULL()
+ REAL, POINTER :: XIBM_POWERS_E=>NULL()
+ REAL, POINTER :: XIBM_POWERS_V=>NULL()
+ !
+ REAL, POINTER :: XIBM_FORC_BOUNN_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUNT_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUNC_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_P=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_Q=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_R=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_S=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_T=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_E=>NULL()
+ !
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1NV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1TV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1CV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNR_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_E=>NULL()
+ !
+ REAL, POINTER :: XIBM_RUG=>NULL()
+ REAL, POINTER :: XIBM_VISC=>NULL()
+ REAL, POINTER :: XIBM_CNU=>NULL()
+ !
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_XMUT=>NULL()
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_CURV=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_LS=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SU=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SUTR=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_P=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:) , POINTER :: NIBM_IMAGE_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:) , POINTER :: NIBM_IMAGE_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_V=>NULL()
+ !
+CONTAINS
+ !
+ SUBROUTINE IBM_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ ! Save current state for allocated arrays
+ IBM_MODEL(KFROM)%XIBM_XMUT=>XIBM_XMUT
+ IBM_MODEL(KFROM)%XIBM_CURV=>XIBM_CURV
+ IBM_MODEL(KFROM)%XIBM_LS=>XIBM_LS
+ IBM_MODEL(KFROM)%XIBM_SU=>XIBM_SU
+ IBM_MODEL(KFROM)%XIBM_GHOST_P=>XIBM_GHOST_P
+ IBM_MODEL(KFROM)%XIBM_GHOST_V=>XIBM_GHOST_V
+ IBM_MODEL(KFROM)%XIBM_GHOST_P=>XIBM_GHOST_P
+ IBM_MODEL(KFROM)%XIBM_GHOST_V=>XIBM_GHOST_V
+ IBM_MODEL(KFROM)%NIBM_IMAGE_P=>NIBM_IMAGE_P
+ IBM_MODEL(KFROM)%NIBM_IMAGE_V=>NIBM_IMAGE_V
+ IBM_MODEL(KFROM)%NIBM_IMAGE_P=>NIBM_IMAGE_P
+ IBM_MODEL(KFROM)%NIBM_IMAGE_V=>NIBM_IMAGE_V
+ IBM_MODEL(KFROM)%XIBM_TESTI_P=>XIBM_TESTI_P
+ IBM_MODEL(KFROM)%XIBM_TESTI_V=>XIBM_TESTI_V
+ !
+ ! Current model is set to model KTO
+ LIBM=>IBM_MODEL(KTO)%LIBM
+ LIBM_TROUBLE=>IBM_MODEL(KTO)%LIBM_TROUBLE
+ CIBM_ADV=>IBM_MODEL(KTO)%CIBM_ADV
+ XIBM_EPSI=>IBM_MODEL(KTO)%XIBM_EPSI
+ XIBM_IEPS=>IBM_MODEL(KTO)%XIBM_IEPS
+ XIBM_RUG=>IBM_MODEL(KTO)%XIBM_RUG
+ XIBM_VISC=>IBM_MODEL(KTO)%XIBM_VISC
+ XIBM_CNU=>IBM_MODEL(KTO)%XIBM_CNU
+ NIBM_ITR=>IBM_MODEL(KTO)%NIBM_ITR
+ NIBM_LAYER_E=>IBM_MODEL(KTO)%NIBM_LAYER_E
+ NIBM_LAYER_P=>IBM_MODEL(KTO)%NIBM_LAYER_P
+ NIBM_LAYER_Q=>IBM_MODEL(KTO)%NIBM_LAYER_Q
+ NIBM_LAYER_R=>IBM_MODEL(KTO)%NIBM_LAYER_R
+ NIBM_LAYER_S=>IBM_MODEL(KTO)%NIBM_LAYER_S
+ NIBM_LAYER_T=>IBM_MODEL(KTO)%NIBM_LAYER_T
+ NIBM_LAYER_V=>IBM_MODEL(KTO)%NIBM_LAYER_V
+ XIBM_XMUT=>IBM_MODEL(KTO)%XIBM_XMUT
+ XIBM_CURV=>IBM_MODEL(KTO)%XIBM_CURV
+ XIBM_LS=>IBM_MODEL(KTO)%XIBM_LS
+ XIBM_SU=>IBM_MODEL(KTO)%XIBM_SU
+ XIBM_SUTR=>IBM_MODEL(KTO)%XIBM_SUTR
+ XIBM_GHOST_P=>IBM_MODEL(KTO)%XIBM_GHOST_P
+ XIBM_GHOST_V=>IBM_MODEL(KTO)%XIBM_GHOST_V
+ NIBM_GHOST_P=>IBM_MODEL(KTO)%NIBM_GHOST_P
+ NIBM_GHOST_V=>IBM_MODEL(KTO)%NIBM_GHOST_V
+ XIBM_IMAGE_P=>IBM_MODEL(KTO)%XIBM_IMAGE_P
+ XIBM_IMAGE_V=>IBM_MODEL(KTO)%XIBM_IMAGE_V
+ NIBM_IMAGE_P=>IBM_MODEL(KTO)%NIBM_IMAGE_P
+ NIBM_IMAGE_V=>IBM_MODEL(KTO)%NIBM_IMAGE_V
+ XIBM_TESTI_P=>IBM_MODEL(KTO)%XIBM_TESTI_P
+ XIBM_TESTI_V=>IBM_MODEL(KTO)%XIBM_TESTI_V
+ XIBM_RADIUS_P=>IBM_MODEL(KTO)%XIBM_RADIUS_P
+ XIBM_POWERS_P=>IBM_MODEL(KTO)%XIBM_POWERS_P
+ XIBM_RADIUS_Q=>IBM_MODEL(KTO)%XIBM_RADIUS_Q
+ XIBM_POWERS_Q=>IBM_MODEL(KTO)%XIBM_POWERS_Q
+ XIBM_RADIUS_R=>IBM_MODEL(KTO)%XIBM_RADIUS_R
+ XIBM_POWERS_R=>IBM_MODEL(KTO)%XIBM_POWERS_R
+ XIBM_RADIUS_S=>IBM_MODEL(KTO)%XIBM_RADIUS_S
+ XIBM_POWERS_S=>IBM_MODEL(KTO)%XIBM_POWERS_S
+ XIBM_RADIUS_T=>IBM_MODEL(KTO)%XIBM_RADIUS_T
+ XIBM_POWERS_T=>IBM_MODEL(KTO)%XIBM_POWERS_T
+ XIBM_RADIUS_E=>IBM_MODEL(KTO)%XIBM_RADIUS_E
+ XIBM_POWERS_E=>IBM_MODEL(KTO)%XIBM_POWERS_E
+ XIBM_RADIUS_V=>IBM_MODEL(KTO)%XIBM_RADIUS_V
+ XIBM_POWERS_V=>IBM_MODEL(KTO)%XIBM_POWERS_V
+ XIBM_FORC_BOUND_P => IBM_MODEL(KTO)%XIBM_FORC_BOUND_P
+ XIBM_FORC_BOUND_Q => IBM_MODEL(KTO)%XIBM_FORC_BOUND_Q
+ XIBM_FORC_BOUND_R => IBM_MODEL(KTO)%XIBM_FORC_BOUND_R
+ XIBM_FORC_BOUND_S => IBM_MODEL(KTO)%XIBM_FORC_BOUND_S
+ XIBM_FORC_BOUND_T => IBM_MODEL(KTO)%XIBM_FORC_BOUND_T
+ XIBM_FORC_BOUND_E => IBM_MODEL(KTO)%XIBM_FORC_BOUND_E
+ XIBM_FORC_BOUNN_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNN_V
+ XIBM_FORC_BOUNT_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNT_V
+ XIBM_FORC_BOUNC_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNC_V
+ CIBM_MODE_INTE1_P => IBM_MODEL(KTO)%CIBM_MODE_INTE1_P
+ CIBM_MODE_INTE3_P => IBM_MODEL(KTO)%CIBM_MODE_INTE3_P
+ CIBM_MODE_BOUND_P => IBM_MODEL(KTO)%CIBM_MODE_BOUND_P
+ CIBM_TYPE_BOUND_P => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_P
+ CIBM_MODE_INTE1_Q => IBM_MODEL(KTO)%CIBM_MODE_INTE1_Q
+ CIBM_MODE_INTE3_Q => IBM_MODEL(KTO)%CIBM_MODE_INTE3_Q
+ CIBM_MODE_BOUND_Q => IBM_MODEL(KTO)%CIBM_MODE_BOUND_Q
+ CIBM_TYPE_BOUND_Q => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_Q
+ CIBM_MODE_INTE1_R => IBM_MODEL(KTO)%CIBM_MODE_INTE1_R
+ CIBM_MODE_INTE3_R => IBM_MODEL(KTO)%CIBM_MODE_INTE3_R
+ CIBM_MODE_BOUND_R => IBM_MODEL(KTO)%CIBM_MODE_BOUND_R
+ CIBM_TYPE_BOUND_R => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_R
+ CIBM_MODE_INTE1_S => IBM_MODEL(KTO)%CIBM_MODE_INTE1_S
+ CIBM_MODE_INTE3_S => IBM_MODEL(KTO)%CIBM_MODE_INTE3_S
+ CIBM_MODE_BOUND_S => IBM_MODEL(KTO)%CIBM_MODE_BOUND_S
+ CIBM_TYPE_BOUND_S => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_S
+ CIBM_MODE_INTE1_T => IBM_MODEL(KTO)%CIBM_MODE_INTE1_T
+ CIBM_MODE_INTE3_T => IBM_MODEL(KTO)%CIBM_MODE_INTE3_T
+ CIBM_MODE_BOUND_T => IBM_MODEL(KTO)%CIBM_MODE_BOUND_T
+ CIBM_TYPE_BOUND_T => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_T
+ CIBM_MODE_INTE1_E => IBM_MODEL(KTO)%CIBM_MODE_INTE1_E
+ CIBM_MODE_INTE3_E => IBM_MODEL(KTO)%CIBM_MODE_INTE3_E
+ CIBM_MODE_BOUND_E => IBM_MODEL(KTO)%CIBM_MODE_BOUND_E
+ CIBM_TYPE_BOUND_E => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_E
+ CIBM_MODE_INTE1NV => IBM_MODEL(KTO)%CIBM_MODE_INTE1NV
+ CIBM_MODE_INTE1TV => IBM_MODEL(KTO)%CIBM_MODE_INTE1TV
+ CIBM_MODE_INTE1CV => IBM_MODEL(KTO)%CIBM_MODE_INTE1CV
+ CIBM_MODE_INTE3_V => IBM_MODEL(KTO)%CIBM_MODE_INTE3_V
+ CIBM_MODE_BOUNN_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNN_V
+ CIBM_TYPE_BOUNN_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNN_V
+ CIBM_MODE_BOUNT_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNT_V
+ CIBM_TYPE_BOUNT_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNT_V
+ CIBM_MODE_BOUNC_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNC_V
+ CIBM_TYPE_BOUNC_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNC_V
+ CIBM_FORC_BOUNN_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNR_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNR_V
+ CIBM_FORC_BOUNT_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNT_V
+ CIBM_FORC_BOUNC_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNC_V
+ CIBM_FORC_BOUND_P => IBM_MODEL(KTO)%CIBM_FORC_BOUND_P
+ CIBM_FORC_BOUND_Q => IBM_MODEL(KTO)%CIBM_FORC_BOUND_Q
+ CIBM_FORC_BOUND_R => IBM_MODEL(KTO)%CIBM_FORC_BOUND_R
+ CIBM_FORC_BOUND_S => IBM_MODEL(KTO)%CIBM_FORC_BOUND_S
+ CIBM_FORC_BOUND_T => IBM_MODEL(KTO)%CIBM_FORC_BOUND_T
+ CIBM_FORC_BOUND_E => IBM_MODEL(KTO)%CIBM_FORC_BOUND_E
+ !
+ END SUBROUTINE IBM_GOTO_MODEL
+ !
+END MODULE MODD_IBM_PARAM_n
+!
diff --git a/src/MNH/modd_mean_fieldn.f90 b/src/MNH/modd_mean_fieldn.f90
index 0bf49a62dd62c1e4cf4f52d8f5ea45cebf83e27c..bfe8f66e3a3300ff875fe31c343ed6cf6aab81a5 100644
--- a/src/MNH/modd_mean_fieldn.f90
+++ b/src/MNH/modd_mean_fieldn.f90
@@ -51,8 +51,9 @@ TYPE MEAN_FIELD_t
REAL, DIMENSION(:,:,:), POINTER :: XTEMPM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKEM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM_MEAN=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XSVT_MEAN=>NULL()
- REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL(),XUW_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTH2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMP2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABS2_MEAN=>NULL()
@@ -76,8 +77,9 @@ REAL, DIMENSION(:,:,:), POINTER :: XTHM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMPM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKEM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM_MEAN=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSVT_MEAN=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL(),XUW_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTH2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMP2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABS2_MEAN=>NULL()
@@ -103,6 +105,7 @@ MEAN_FIELD_MODEL(KFROM)%XTHM_MEAN=>XTHM_MEAN
MEAN_FIELD_MODEL(KFROM)%XTEMPM_MEAN=>XTEMPM_MEAN
MEAN_FIELD_MODEL(KFROM)%XTKEM_MEAN=>XTKEM_MEAN
MEAN_FIELD_MODEL(KFROM)%XPABSM_MEAN=>XPABSM_MEAN
+MEAN_FIELD_MODEL(KFROM)%XSVT_MEAN=>XSVT_MEAN
MEAN_FIELD_MODEL(KFROM)%XUM_MAX=>XUM_MAX
MEAN_FIELD_MODEL(KFROM)%XVM_MAX=>XVM_MAX
@@ -115,6 +118,7 @@ MEAN_FIELD_MODEL(KFROM)%XPABSM_MAX=>XPABSM_MAX
MEAN_FIELD_MODEL(KFROM)%XU2_MEAN=>XU2_MEAN
MEAN_FIELD_MODEL(KFROM)%XV2_MEAN=>XV2_MEAN
MEAN_FIELD_MODEL(KFROM)%XW2_MEAN=>XW2_MEAN
+MEAN_FIELD_MODEL(KFROM)%XUW_MEAN=>XUW_MEAN
MEAN_FIELD_MODEL(KFROM)%XTH2_MEAN=>XTH2_MEAN
MEAN_FIELD_MODEL(KFROM)%XTEMP2_MEAN=>XTEMP2_MEAN
MEAN_FIELD_MODEL(KFROM)%XPABS2_MEAN=>XPABS2_MEAN
@@ -128,6 +132,7 @@ XTHM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTHM_MEAN
XTEMPM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTEMPM_MEAN
XTKEM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTKEM_MEAN
XPABSM_MEAN=>MEAN_FIELD_MODEL(KTO)%XPABSM_MEAN
+XSVT_MEAN=>MEAN_FIELD_MODEL(KTO)%XSVT_MEAN
XUM_MAX=>MEAN_FIELD_MODEL(KTO)%XUM_MAX
XVM_MAX=>MEAN_FIELD_MODEL(KTO)%XVM_MAX
@@ -140,6 +145,7 @@ XPABSM_MAX=>MEAN_FIELD_MODEL(KTO)%XPABSM_MAX
XU2_MEAN=>MEAN_FIELD_MODEL(KTO)%XU2_MEAN
XV2_MEAN=>MEAN_FIELD_MODEL(KTO)%XV2_MEAN
XW2_MEAN=>MEAN_FIELD_MODEL(KTO)%XW2_MEAN
+XUW_MEAN=>MEAN_FIELD_MODEL(KTO)%XUW_MEAN
XTH2_MEAN=>MEAN_FIELD_MODEL(KTO)%XTH2_MEAN
XTEMP2_MEAN=>MEAN_FIELD_MODEL(KTO)%XTEMP2_MEAN
XPABS2_MEAN=>MEAN_FIELD_MODEL(KTO)%XPABS2_MEAN
diff --git a/src/MNH/modd_recycl_paramn.f90 b/src/MNH/modd_recycl_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9e13056f602f06ee5d76f9805d4218c1772548f1
--- /dev/null
+++ b/src/MNH/modd_recycl_paramn.f90
@@ -0,0 +1,168 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+ MODULE MODD_RECYCL_PARAM_n
+! #######################
+!
+!**** MODD_RECYCL_PARAM_n - declaration of the control parameters
+! used in the turbulence recycling method
+!
+! PURPOSE
+! -------
+!**** The purpose of this module is to declare the constants
+! allowing to initialize the turbulence recycling method
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! None
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Tim Nagel (Meteo-France)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/02/2021
+!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+!
+TYPE RECYCL_t
+!
+LOGICAL :: LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS ! Recycling logical
+REAL :: XDRECYCLN,XDRECYCLW,XDRECYCLE,XDRECYCLS, &
+ XARECYCLN,XARECYCLW,XARECYCLE,XARECYCLS, &
+ XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+
+INTEGER :: R_COUNT
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANS=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANS=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANS=>NULL()
+!
+END TYPE RECYCL_t
+
+TYPE(RECYCL_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: RECYCL_MODEL
+
+LOGICAL ,POINTER :: LRECYCL=>NULL()
+LOGICAL ,POINTER :: LRECYCLN=>NULL()
+LOGICAL ,POINTER :: LRECYCLW=>NULL()
+LOGICAL ,POINTER :: LRECYCLE=>NULL()
+LOGICAL ,POINTER :: LRECYCLS=>NULL()
+
+REAL ,POINTER :: XDRECYCLN=>NULL()
+REAL ,POINTER :: XARECYCLN=>NULL()
+REAL ,POINTER :: XDRECYCLW=>NULL()
+REAL ,POINTER :: XARECYCLW=>NULL()
+REAL ,POINTER :: XDRECYCLE=>NULL()
+REAL ,POINTER :: XARECYCLE=>NULL()
+REAL ,POINTER :: XDRECYCLS=>NULL()
+REAL ,POINTER :: XARECYCLS=>NULL()
+REAL ,POINTER :: XTMOY=>NULL()
+REAL ,POINTER :: XTMOYCOUNT=>NULL()
+REAL ,POINTER :: XNUMBELT=>NULL()
+REAL ,POINTER :: XRCOEFF=>NULL()
+REAL ,POINTER :: XTBVTOP=>NULL()
+REAL ,POINTER :: XTBVBOT=>NULL()
+
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANS=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANS=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANS=>NULL()
+
+
+
+INTEGER ,POINTER :: R_COUNT =>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XTBV=>NULL()
+
+CONTAINS
+
+SUBROUTINE RECYCL_GOTO_MODEL(KFROM, KTO)
+
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+RECYCL_MODEL(KFROM)%XUMEANW=>XUMEANW
+RECYCL_MODEL(KFROM)%XVMEANW=>XVMEANW
+RECYCL_MODEL(KFROM)%XWMEANW=>XWMEANW
+RECYCL_MODEL(KFROM)%XUMEANN=>XUMEANN
+RECYCL_MODEL(KFROM)%XVMEANN=>XVMEANN
+RECYCL_MODEL(KFROM)%XWMEANN=>XWMEANN
+RECYCL_MODEL(KFROM)%XUMEANE=>XUMEANE
+RECYCL_MODEL(KFROM)%XVMEANE=>XVMEANE
+RECYCL_MODEL(KFROM)%XWMEANE=>XWMEANE
+RECYCL_MODEL(KFROM)%XUMEANS=>XUMEANS
+RECYCL_MODEL(KFROM)%XVMEANS=>XVMEANS
+RECYCL_MODEL(KFROM)%XWMEANS=>XWMEANS
+
+
+!
+! Current model is set to model KTO
+LRECYCL=>RECYCL_MODEL(KTO)%LRECYCL
+LRECYCLN=>RECYCL_MODEL(KTO)%LRECYCLN
+LRECYCLW=>RECYCL_MODEL(KTO)%LRECYCLW
+LRECYCLE=>RECYCL_MODEL(KTO)%LRECYCLE
+LRECYCLS=>RECYCL_MODEL(KTO)%LRECYCLS
+XDRECYCLN=>RECYCL_MODEL(KTO)%XDRECYCLN
+XARECYCLN=>RECYCL_MODEL(KTO)%XARECYCLN
+XDRECYCLW=>RECYCL_MODEL(KTO)%XDRECYCLW
+XARECYCLW=>RECYCL_MODEL(KTO)%XARECYCLW
+XDRECYCLE=>RECYCL_MODEL(KTO)%XDRECYCLE
+XARECYCLE=>RECYCL_MODEL(KTO)%XARECYCLE
+XDRECYCLS=>RECYCL_MODEL(KTO)%XDRECYCLS
+XARECYCLS=>RECYCL_MODEL(KTO)%XARECYCLS
+XTMOY=>RECYCL_MODEL(KTO)%XTMOY
+XTMOYCOUNT=>RECYCL_MODEL(KTO)%XTMOYCOUNT
+XNUMBELT=>RECYCL_MODEL(KTO)%XNUMBELT
+XRCOEFF=>RECYCL_MODEL(KTO)%XRCOEFF
+XTBVTOP=>RECYCL_MODEL(KTO)%XTBVTOP
+XTBVBOT=>RECYCL_MODEL(KTO)%XTBVBOT
+
+XUMEANW=>RECYCL_MODEL(KTO)%XUMEANW
+XVMEANW=>RECYCL_MODEL(KTO)%XVMEANW
+XWMEANW=>RECYCL_MODEL(KTO)%XWMEANW
+XUMEANN=>RECYCL_MODEL(KTO)%XUMEANN
+XVMEANN=>RECYCL_MODEL(KTO)%XVMEANN
+XWMEANN=>RECYCL_MODEL(KTO)%XWMEANN
+XUMEANE=>RECYCL_MODEL(KTO)%XUMEANE
+XVMEANE=>RECYCL_MODEL(KTO)%XVMEANE
+XWMEANE=>RECYCL_MODEL(KTO)%XWMEANE
+XUMEANS=>RECYCL_MODEL(KTO)%XUMEANS
+XVMEANS=>RECYCL_MODEL(KTO)%XVMEANS
+XWMEANS=>RECYCL_MODEL(KTO)%XWMEANS
+
+R_COUNT=>RECYCL_MODEL(KTO)%R_COUNT
+
+END SUBROUTINE RECYCL_GOTO_MODEL
+
+END MODULE MODD_RECYCL_PARAM_n
+!
+
diff --git a/src/MNH/modd_sub_modeln.f90 b/src/MNH/modd_sub_modeln.f90
index 351bb95b074094b5dc3add37f8a18b587ca221de..f4ed4089cd95efc9450293846468a61dd4809cba 100644
--- a/src/MNH/modd_sub_modeln.f90
+++ b/src/MNH/modd_sub_modeln.f90
@@ -11,6 +11,7 @@
! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
! P. Wautelet 07/01/2021: rename ibak/iout into nfile_backup_current/nfile_output_current
+! F. Auguste 01/02/2021: add IBM
!-----------------------------------------------------------------
! #################
MODULE MODD_SUB_MODEL_n
@@ -47,6 +48,7 @@ TYPE SUB_MODEL_t
REAL(kind=MNHTIME), DIMENSION(2) :: XT_HALO, XT_RAD_BOUND, XT_PRESS
REAL(kind=MNHTIME), DIMENSION(2) :: XT_CLOUD, XT_STEP_SWA, XT_STEP_MISC
REAL(kind=MNHTIME), DIMENSION(2) :: XT_ELEC
+ REAL(kind=MNHTIME), DIMENSION(2) :: XT_IBM_FORC,XT_IBM_DETE,XT_IBM_PREP
REAL(kind=MNHTIME), DIMENSION(2) :: XT_COUPL, XT_1WAY, XT_STEP_BUD
REAL(kind=MNHTIME), DIMENSION(2) :: XT_RAD, XT_DCONV, XT_GROUND, XT_TRACER, XT_MAFL
REAL(kind=MNHTIME), DIMENSION(2) :: XT_TURB, XT_2WAY, XT_SHADOWS
@@ -75,6 +77,7 @@ REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_HALO=>NULL(), XT_RAD_BOUND=>NULL
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_VISC=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_CLOUD=>NULL(), XT_STEP_SWA=>NULL(), XT_STEP_MISC=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ELEC=>NULL(), XT_SHADOWS=>NULL()
+REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_IBM_FORC=>NULL(),XT_IBM_PREP=>NULL(),XT_IBM_DETE=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_COUPL=>NULL(), XT_1WAY=>NULL(), XT_STEP_BUD=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_RAD=>NULL(), XT_DCONV=>NULL(), XT_GROUND=>NULL(), XT_MAFL=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_TURB=>NULL(), XT_2WAY=>NULL(), XT_TRACER=>NULL()
@@ -138,6 +141,9 @@ XT_RAD_BOUND=>SUB_MODEL_MODEL(KTO)%XT_RAD_BOUND
XT_PRESS=>SUB_MODEL_MODEL(KTO)%XT_PRESS
XT_CLOUD=>SUB_MODEL_MODEL(KTO)%XT_CLOUD
XT_ELEC=>SUB_MODEL_MODEL(KTO)%XT_ELEC
+XT_IBM_FORC=>SUB_MODEL_MODEL(KTO)%XT_IBM_FORC
+XT_IBM_DETE=>SUB_MODEL_MODEL(KTO)%XT_IBM_DETE
+XT_IBM_PREP=>SUB_MODEL_MODEL(KTO)%XT_IBM_PREP
XT_STEP_SWA=>SUB_MODEL_MODEL(KTO)%XT_STEP_SWA
XT_STEP_MISC=>SUB_MODEL_MODEL(KTO)%XT_STEP_MISC
XT_COUPL=>SUB_MODEL_MODEL(KTO)%XT_COUPL
diff --git a/src/MNH/modd_turbn.f90 b/src/MNH/modd_turbn.f90
index 7bb60fe404c6f8cdef2c8a00ac6752ab1e974f1b..a108cce8fe278a4d0df9e01a0d0681974e5a4b80 100644
--- a/src/MNH/modd_turbn.f90
+++ b/src/MNH/modd_turbn.f90
@@ -55,6 +55,7 @@ TYPE TURB_t
! the turbulence scheme
REAL :: XKEMIN ! mimimum value for the TKE
REAL :: XCEDIS ! Constant for dissipation of Tke
+ REAL :: XCADAP ! Coefficient for ADAPtative mixing length
CHARACTER (LEN=4) :: CTURBLEN ! type of length used for the closure
! 'BL89' Bougeault and Lacarrere scheme
! 'DELT' length = ( volum) ** 1/3
@@ -100,6 +101,7 @@ TYPE(TURB_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: TURB_MODEL
REAL, POINTER :: XIMPL=>NULL()
REAL, POINTER :: XKEMIN=>NULL()
REAL, POINTER :: XCEDIS=>NULL()
+REAL, POINTER :: XCADAP=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBLEN=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBDIM=>NULL()
LOGICAL, POINTER :: LTURB_FLX=>NULL()
@@ -144,6 +146,7 @@ TURB_MODEL(KFROM)%XLEM=>XLEM
XIMPL=>TURB_MODEL(KTO)%XIMPL
XKEMIN=>TURB_MODEL(KTO)%XKEMIN
XCEDIS=>TURB_MODEL(KTO)%XCEDIS
+XCADAP=>TURB_MODEL(KTO)%XCADAP
CTURBLEN=>TURB_MODEL(KTO)%CTURBLEN
CTURBDIM=>TURB_MODEL(KTO)%CTURBDIM
LTURB_FLX=>TURB_MODEL(KTO)%LTURB_FLX
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 934a06accd589bfffec27947d57dffe790cb50f0..0c5a12fef4a4452c662ba91efc49b836ede28e44 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -268,7 +268,9 @@ END MODULE MODI_MODEL_n
! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
-! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
+! F. Auguste 01/02/2021: add IBM
+! T. Nagel 01/02/2021: add turbulence recycling
+! P. Wautelet 19/02/2021 add NEGA2 term for SV budgets
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -277,6 +279,7 @@ END MODULE MODI_MODEL_n
USE MODD_2D_FRC
USE MODD_ADV_n
USE MODD_AIRCRAFT_BALLOON
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_BAKOUT
USE MODD_BIKHARDT_n
USE MODD_BLANK_n
@@ -310,6 +313,7 @@ USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_GRID_n
+USE MODD_IBM_PARAM_n !, ONLY : LIBM, LIBM_TROUBLE, CIBM_ADV, XT_IBM_FORC, XIBM_LS
USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
USE MODD_LBC_n
@@ -337,12 +341,14 @@ USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, MWARM => LWARM, MRAIN => LRAIN, &
XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
+USE MODD_PASPOL, ONLY : LPASPOL
USE MODD_PAST_FIELD_n
USE MODD_PRECIP_n
use modd_precision, only: MNHTIME
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RECYCL_PARAM_n
USE MODD_REF_n
USE MODD_SALT, ONLY: LSALT
USE MODD_SERIES, ONLY: LSERIES
@@ -371,10 +377,12 @@ use mode_menu_diachro, only: MENU_DIACHRO
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
+USE MODE_MSG
USE MODE_ONE_WAY_n
use mode_write_les_n, only: Write_les_n
use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
!
+USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
USE MODI_ADVECTION_UVW
USE MODI_ADVECTION_UVW_CEN
@@ -397,6 +405,10 @@ USE MODI_FORC_SQUALL_LINE
USE MODI_FORC_WIND
USE MODI_GET_HALO
USE MODI_GRAVITY_IMPL
+USE MODI_IBM_INIT
+USE MODI_IBM_FORCING
+USE MODI_IBM_FORCING_TR
+USE MODI_IBM_FORCING_ADV
USE MODI_INI_DIAG_IN_RUN
USE MODI_INI_LG
USE MODI_INI_MEAN_FIELD
@@ -415,6 +427,7 @@ USE MODI_PHYS_PARAM_n
USE MODI_PRESSUREZ
USE MODI_PROFILER_n
USE MODI_RAD_BOUND
+USE MODI_RECYCLING
USE MODI_RELAX2FW_ION
USE MODI_RELAXATION
USE MODI_REL_FORCING_n
@@ -722,6 +735,8 @@ IF (KTCOUNT == 1) THEN
XT_CHEM = 0.0_MNHTIME
XT_2WAY = 0.0_MNHTIME
!
+ XT_IBM_FORC = 0.0_MNHTIME
+ !
END IF
!
!* 1.7 Allocation of arrays for observation diagnostics
@@ -872,7 +887,28 @@ IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) TH
END IF
!
CALL SECOND_MNH2(ZTIME2)
-XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+!
+!* 2.1 RECYCLING TURBULENCE
+! ----
+IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
+ CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
+ XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
+ KTCOUNT)
+ENDIF
+!
+!* 2.2 IBM
+! ----
+!
+IF (LIBM .AND. KTCOUNT==1) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_INIT(XIBM_LS)
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -981,6 +1017,42 @@ XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
+!* 4.BIS IBM and Fluctuations application
+! -----------------------------
+!
+!* 4.B1 Add fluctuations at the domain boundaries
+!
+IF (LRECYCL) THEN
+ CALL ADDFLUCTUATIONS ( &
+ CLBCX,CLBCY, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, &
+ XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, &
+ XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE )
+ENDIF
+!
+!* 4.B2 Immersed boundaries
+!
+IF (LIBM) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ !
+ IF (LIBM_TROUBLE) THEN
+ CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ ENDIF
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!-------------------------------------------------------------------------------
+!
!* 5. INITIALIZATION OF THE BUDGET VARIABLES
! --------------------------------------
!
@@ -1559,6 +1631,18 @@ CALL SECOND_MNH2(ZTIME2)
!
XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
+IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS)
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
@@ -1642,6 +1726,7 @@ CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
XDXHAT, XDYHAT, XZHAT, &
XUT, XVT, &
XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
+ XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, &
XCPHASE, XCPHASE_PBL, XRHODJ, &
XTKET,XRUS, XRVS, XRWS )
ZRUS=XRUS-ZRUS
@@ -1951,7 +2036,7 @@ XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
! --------------------
!
IF (LMEAN_FIELD) THEN
- CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST)
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
END IF
!
!-------------------------------------------------------------------------------
@@ -2141,6 +2226,7 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
+ CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=')
CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=')
@@ -2181,12 +2267,13 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=')
CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=')
CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=')
+ IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=')
!
! sum of call subroutine
!
ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
- XT_ADVUVW + XT_GRAV + &
+ XT_ADVUVW + XT_GRAV + XT_IBM_FORC + &
XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + &
XT_STEP_MISC+ XT_STEP_BUD
diff --git a/src/MNH/modn_ibm_paramn.f90 b/src/MNH/modn_ibm_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..33fcce52f5d8102d5f1739cf0e5ebb8cfe14eeae
--- /dev/null
+++ b/src/MNH/modn_ibm_paramn.f90
@@ -0,0 +1,373 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+ MODULE MODN_IBM_PARAM_n
+! #######################
+!
+!**** *MODN_IBM_PARAM$n* - declaration of namelist NAM_IBM_PARAMn
+!
+! PURPOSE
+! -------
+!**** The purpose of this declarative module is to declare the constants
+! which allow to initialize the embedded surface
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! Module MODD_IBM_PARAM$n : contains declaration of IBM parameters
+!
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Franck Auguste (CERFACS-AE)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/01/2019
+!
+USE MODD_IBM_PARAM_n, ONLY: &
+ LIBM_n => LIBM, &
+ NIBM_ITR_n => NIBM_ITR, &
+ CIBM_ADV_n => CIBM_ADV, &
+ LIBM_TROUBLE_n => LIBM_TROUBLE, &
+ XIBM_EPSI_n => XIBM_EPSI, &
+ XIBM_IEPS_n => XIBM_IEPS, &
+ XIBM_RUG_n => XIBM_RUG, &
+ XIBM_VISC_n => XIBM_VISC, &
+ XIBM_CNU_n => XIBM_CNU, &
+
+ NIBM_LAYER_P_n => NIBM_LAYER_P ,&
+ XIBM_RADIUS_P_n => XIBM_RADIUS_P ,&
+ XIBM_POWERS_P_n => XIBM_POWERS_P ,&
+ CIBM_MODE_INTE1_P_n => CIBM_MODE_INTE1_P ,&
+ CIBM_MODE_INTE3_P_n => CIBM_MODE_INTE3_P ,&
+ CIBM_MODE_BOUND_P_n => CIBM_MODE_BOUND_P ,&
+ CIBM_TYPE_BOUND_P_n => CIBM_TYPE_BOUND_P ,&
+ CIBM_FORC_BOUND_P_n => CIBM_FORC_BOUND_P ,&
+ XIBM_FORC_BOUND_P_n => XIBM_FORC_BOUND_P ,&
+
+ NIBM_LAYER_Q_n => NIBM_LAYER_Q ,&
+ XIBM_RADIUS_Q_n => XIBM_RADIUS_Q ,&
+ XIBM_POWERS_Q_n => XIBM_POWERS_Q ,&
+ CIBM_MODE_INTE1_Q_n => CIBM_MODE_INTE1_Q ,&
+ CIBM_MODE_INTE3_Q_n => CIBM_MODE_INTE3_Q ,&
+ CIBM_MODE_BOUND_Q_n => CIBM_MODE_BOUND_Q ,&
+ CIBM_TYPE_BOUND_Q_n => CIBM_TYPE_BOUND_Q ,&
+ CIBM_FORC_BOUND_Q_n => CIBM_FORC_BOUND_Q ,&
+ XIBM_FORC_BOUND_Q_n => XIBM_FORC_BOUND_Q ,&
+
+ NIBM_LAYER_R_n => NIBM_LAYER_R ,&
+ XIBM_RADIUS_R_n => XIBM_RADIUS_R ,&
+ XIBM_POWERS_R_n => XIBM_POWERS_R ,&
+ CIBM_MODE_INTE1_R_n => CIBM_MODE_INTE1_R ,&
+ CIBM_MODE_INTE3_R_n => CIBM_MODE_INTE3_R ,&
+ CIBM_MODE_BOUND_R_n => CIBM_MODE_BOUND_R ,&
+ CIBM_TYPE_BOUND_R_n => CIBM_TYPE_BOUND_R ,&
+ CIBM_FORC_BOUND_R_n => CIBM_FORC_BOUND_R ,&
+ XIBM_FORC_BOUND_R_n => XIBM_FORC_BOUND_R ,&
+
+ NIBM_LAYER_S_n => NIBM_LAYER_S ,&
+ XIBM_RADIUS_S_n => XIBM_RADIUS_S ,&
+ XIBM_POWERS_S_n => XIBM_POWERS_S ,&
+ CIBM_MODE_INTE1_S_n => CIBM_MODE_INTE1_S ,&
+ CIBM_MODE_INTE3_S_n => CIBM_MODE_INTE3_S ,&
+ CIBM_MODE_BOUND_S_n => CIBM_MODE_BOUND_S ,&
+ CIBM_TYPE_BOUND_S_n => CIBM_TYPE_BOUND_S ,&
+ CIBM_FORC_BOUND_S_n => CIBM_FORC_BOUND_S ,&
+ XIBM_FORC_BOUND_S_n => XIBM_FORC_BOUND_S ,&
+
+ NIBM_LAYER_T_n => NIBM_LAYER_T ,&
+ XIBM_RADIUS_T_n => XIBM_RADIUS_T ,&
+ XIBM_POWERS_T_n => XIBM_POWERS_T ,&
+ CIBM_MODE_INTE1_T_n => CIBM_MODE_INTE1_T ,&
+ CIBM_MODE_INTE3_T_n => CIBM_MODE_INTE3_T ,&
+ CIBM_MODE_BOUND_T_n => CIBM_MODE_BOUND_T ,&
+ CIBM_TYPE_BOUND_T_n => CIBM_TYPE_BOUND_T ,&
+ CIBM_FORC_BOUND_T_n => CIBM_FORC_BOUND_T ,&
+ XIBM_FORC_BOUND_T_n => XIBM_FORC_BOUND_T ,&
+
+ NIBM_LAYER_E_n => NIBM_LAYER_E ,&
+ XIBM_RADIUS_E_n => XIBM_RADIUS_E ,&
+ XIBM_POWERS_E_n => XIBM_POWERS_E ,&
+ CIBM_MODE_INTE1_E_n => CIBM_MODE_INTE1_E ,&
+ CIBM_MODE_INTE3_E_n => CIBM_MODE_INTE3_E ,&
+ CIBM_MODE_BOUND_E_n => CIBM_MODE_BOUND_E ,&
+ CIBM_TYPE_BOUND_E_n => CIBM_TYPE_BOUND_E ,&
+ CIBM_FORC_BOUND_E_n => CIBM_FORC_BOUND_E ,&
+ XIBM_FORC_BOUND_E_n => XIBM_FORC_BOUND_E ,&
+
+ NIBM_LAYER_V_n => NIBM_LAYER_V ,&
+ XIBM_RADIUS_V_n => XIBM_RADIUS_V ,&
+ XIBM_POWERS_V_n => XIBM_POWERS_V ,&
+ CIBM_MODE_INTE1NV_n => CIBM_MODE_INTE1NV ,&
+ CIBM_MODE_INTE1TV_n => CIBM_MODE_INTE1TV ,&
+ CIBM_MODE_INTE1CV_n => CIBM_MODE_INTE1CV ,&
+ CIBM_MODE_INTE3_V_n => CIBM_MODE_INTE3_V ,&
+ CIBM_MODE_BOUNN_V_n => CIBM_MODE_BOUNN_V ,&
+ CIBM_TYPE_BOUNN_V_n => CIBM_TYPE_BOUNN_V ,&
+ CIBM_MODE_BOUNT_V_n => CIBM_MODE_BOUNT_V ,&
+ CIBM_TYPE_BOUNT_V_n => CIBM_TYPE_BOUNT_V ,&
+ CIBM_MODE_BOUNC_V_n => CIBM_MODE_BOUNC_V ,&
+ CIBM_TYPE_BOUNC_V_n => CIBM_TYPE_BOUNC_V ,&
+ CIBM_FORC_BOUNN_V_n => CIBM_FORC_BOUNN_V ,&
+ CIBM_FORC_BOUNR_V_n => CIBM_FORC_BOUNR_V ,&
+ CIBM_FORC_BOUNT_V_n => CIBM_FORC_BOUNT_V ,&
+ CIBM_FORC_BOUNC_V_n => CIBM_FORC_BOUNC_V ,&
+ XIBM_FORC_BOUNN_V_n => XIBM_FORC_BOUNN_V ,&
+ XIBM_FORC_BOUNT_V_n => XIBM_FORC_BOUNT_V ,&
+ XIBM_FORC_BOUNC_V_n => XIBM_FORC_BOUNC_V
+!
+IMPLICIT NONE
+!
+LOGICAL,SAVE :: LIBM,LIBM_TROUBLE
+REAL,SAVE :: XIBM_EPSI
+REAL,SAVE :: XIBM_IEPS
+REAL,SAVE :: XIBM_RUG,XIBM_VISC,XIBM_CNU
+INTEGER,SAVE :: NIBM_ITR
+INTEGER,SAVE :: NIBM_LAYER_P,NIBM_LAYER_Q,NIBM_LAYER_R,NIBM_LAYER_S,NIBM_LAYER_T,NIBM_LAYER_E,NIBM_LAYER_V
+CHARACTER (LEN=6),SAVE :: CIBM_ADV
+CHARACTER (LEN=3),SAVE :: CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E,&
+ CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV,&
+ CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S,&
+ CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V
+CHARACTER (LEN=3),SAVE :: CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S,&
+ CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E,&
+ CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S,&
+ CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E,&
+ CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S,&
+ CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E,&
+ CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V,&
+ CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V,&
+ CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V
+REAL,SAVE :: XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V,&
+ XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S,&
+ XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E
+REAL,SAVE :: XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S,&
+ XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V,&
+ XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S,&
+ XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+!
+NAMELIST /NAM_IBM_PARAMn/ LIBM, LIBM_TROUBLE, CIBM_ADV, NIBM_ITR, &
+ XIBM_VISC, XIBM_EPSI, XIBM_IEPS, XIBM_RUG, XIBM_CNU, &
+ NIBM_LAYER_P,NIBM_LAYER_Q,NIBM_LAYER_R,NIBM_LAYER_S,&
+ NIBM_LAYER_T,NIBM_LAYER_E,NIBM_LAYER_V,&
+ CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E,&
+ CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV,&
+ CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S,&
+ CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V,&
+ CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S,&
+ CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E,&
+ CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S,&
+ CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E,&
+ CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S,&
+ CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E,&
+ XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S,&
+ XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E,&
+ CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V,&
+ CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V,&
+ CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V,&
+ XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V,&
+ XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S,&
+ XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V,&
+ XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S,&
+ XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_IBM_PARAMn
+ LIBM = LIBM_n
+ CIBM_ADV = CIBM_ADV_n
+ NIBM_ITR = NIBM_ITR_n
+ LIBM_TROUBLE = LIBM_TROUBLE_n
+ XIBM_EPSI = XIBM_EPSI_n
+ XIBM_IEPS = XIBM_IEPS_n
+ XIBM_RUG = XIBM_RUG_n
+ XIBM_VISC = XIBM_VISC_n
+ XIBM_CNU = XIBM_CNU_n
+
+ NIBM_LAYER_P = NIBM_LAYER_P_n
+ XIBM_RADIUS_P = XIBM_RADIUS_P_n
+ XIBM_POWERS_P = XIBM_POWERS_P_n
+ CIBM_MODE_INTE1_P = CIBM_MODE_INTE1_P_n
+ CIBM_MODE_INTE3_P = CIBM_MODE_INTE3_P_n
+ CIBM_MODE_BOUND_P = CIBM_MODE_BOUND_P_n
+ CIBM_TYPE_BOUND_P = CIBM_TYPE_BOUND_P_n
+ CIBM_FORC_BOUND_P = CIBM_FORC_BOUND_P_n
+ XIBM_FORC_BOUND_P = XIBM_FORC_BOUND_P_n
+
+ NIBM_LAYER_Q = NIBM_LAYER_Q_n
+ XIBM_RADIUS_Q = XIBM_RADIUS_Q_n
+ XIBM_POWERS_Q = XIBM_POWERS_Q_n
+ CIBM_MODE_INTE1_Q = CIBM_MODE_INTE1_Q_n
+ CIBM_MODE_INTE3_Q = CIBM_MODE_INTE3_Q_n
+ CIBM_MODE_BOUND_Q = CIBM_MODE_BOUND_Q_n
+ CIBM_TYPE_BOUND_Q = CIBM_TYPE_BOUND_Q_n
+ CIBM_FORC_BOUND_Q = CIBM_FORC_BOUND_Q_n
+ XIBM_FORC_BOUND_Q = XIBM_FORC_BOUND_Q_n
+
+ NIBM_LAYER_R = NIBM_LAYER_R_n
+ XIBM_RADIUS_R = XIBM_RADIUS_R_n
+ XIBM_POWERS_R = XIBM_POWERS_R_n
+ CIBM_MODE_INTE1_R = CIBM_MODE_INTE1_R_n
+ CIBM_MODE_INTE3_R = CIBM_MODE_INTE3_R_n
+ CIBM_MODE_BOUND_R = CIBM_MODE_BOUND_R_n
+ CIBM_TYPE_BOUND_R = CIBM_TYPE_BOUND_R_n
+ CIBM_FORC_BOUND_R = CIBM_FORC_BOUND_R_n
+ XIBM_FORC_BOUND_R = XIBM_FORC_BOUND_R_n
+
+ NIBM_LAYER_S = NIBM_LAYER_S_n
+ XIBM_RADIUS_S = XIBM_RADIUS_S_n
+ XIBM_POWERS_S = XIBM_POWERS_S_n
+ CIBM_MODE_INTE1_S = CIBM_MODE_INTE1_S_n
+ CIBM_MODE_INTE3_S = CIBM_MODE_INTE3_S_n
+ CIBM_MODE_BOUND_S = CIBM_MODE_BOUND_S_n
+ CIBM_TYPE_BOUND_S = CIBM_TYPE_BOUND_S_n
+ CIBM_FORC_BOUND_S = CIBM_FORC_BOUND_S_n
+ XIBM_FORC_BOUND_S = XIBM_FORC_BOUND_S_n
+
+ NIBM_LAYER_T = NIBM_LAYER_T_n
+ XIBM_RADIUS_T = XIBM_RADIUS_T_n
+ XIBM_POWERS_T = XIBM_POWERS_T_n
+ CIBM_MODE_INTE1_T = CIBM_MODE_INTE1_T_n
+ CIBM_MODE_INTE3_T = CIBM_MODE_INTE3_T_n
+ CIBM_MODE_BOUND_T = CIBM_MODE_BOUND_T_n
+ CIBM_TYPE_BOUND_T = CIBM_TYPE_BOUND_T_n
+ CIBM_FORC_BOUND_T = CIBM_FORC_BOUND_T_n
+ XIBM_FORC_BOUND_T = XIBM_FORC_BOUND_T_n
+
+ NIBM_LAYER_E = NIBM_LAYER_E_n
+ XIBM_RADIUS_E = XIBM_RADIUS_E_n
+ XIBM_POWERS_E = XIBM_POWERS_E_n
+ CIBM_MODE_INTE1_E = CIBM_MODE_INTE1_E_n
+ CIBM_MODE_INTE3_E = CIBM_MODE_INTE3_E_n
+ CIBM_MODE_BOUND_E = CIBM_MODE_BOUND_E_n
+ CIBM_TYPE_BOUND_E = CIBM_TYPE_BOUND_E_n
+ CIBM_FORC_BOUND_E = CIBM_FORC_BOUND_E_n
+ XIBM_FORC_BOUND_E = XIBM_FORC_BOUND_E_n
+
+ NIBM_LAYER_V = NIBM_LAYER_V_n
+ XIBM_RADIUS_V = XIBM_RADIUS_V_n
+ XIBM_POWERS_V = XIBM_POWERS_V_n
+ CIBM_MODE_INTE1NV = CIBM_MODE_INTE1NV_n
+ CIBM_MODE_INTE1TV = CIBM_MODE_INTE1TV_n
+ CIBM_MODE_INTE1CV = CIBM_MODE_INTE1CV_n
+ CIBM_MODE_INTE3_V = CIBM_MODE_INTE3_V_n
+ CIBM_MODE_BOUNN_V = CIBM_MODE_BOUNN_V_n
+ CIBM_TYPE_BOUNN_V = CIBM_TYPE_BOUNN_V_n
+ CIBM_MODE_BOUNT_V = CIBM_MODE_BOUNT_V_n
+ CIBM_TYPE_BOUNT_V = CIBM_TYPE_BOUNT_V_n
+ CIBM_MODE_BOUNC_V = CIBM_MODE_BOUNC_V_n
+ CIBM_TYPE_BOUNC_V = CIBM_TYPE_BOUNC_V_n
+ CIBM_FORC_BOUNN_V = CIBM_FORC_BOUNN_V_n
+ CIBM_FORC_BOUNR_V = CIBM_FORC_BOUNR_V_n
+ CIBM_FORC_BOUNT_V = CIBM_FORC_BOUNT_V_n
+ CIBM_FORC_BOUNC_v = CIBM_FORC_BOUNC_V_n
+ XIBM_FORC_BOUNN_V = XIBM_FORC_BOUNN_V_n
+ XIBM_FORC_BOUNT_V = XIBM_FORC_BOUNT_V_n
+ XIBM_FORC_BOUNC_v = XIBM_FORC_BOUNC_V_n
+
+END SUBROUTINE INIT_NAM_IBM_PARAMn
+
+SUBROUTINE UPDATE_NAM_IBM_PARAMn
+ LIBM_n = LIBM
+ CIBM_ADV_n = CIBM_ADV
+ NIBM_ITR_n = NIBM_ITR
+ LIBM_TROUBLE_n = LIBM_TROUBLE
+ XIBM_EPSI_n = XIBM_EPSI
+ XIBM_IEPS_n = XIBM_IEPS
+ XIBM_RUG_n = XIBM_RUG
+ XIBM_VISC_n = XIBM_VISC
+ XIBM_CNU_n = XIBM_CNU
+
+ NIBM_LAYER_P_n = NIBM_LAYER_P
+ XIBM_RADIUS_P_n = XIBM_RADIUS_P
+ XIBM_POWERS_P_n = XIBM_POWERS_P
+ CIBM_MODE_INTE1_P_n = CIBM_MODE_INTE1_P
+ CIBM_MODE_INTE3_P_n = CIBM_MODE_INTE3_P
+ CIBM_MODE_BOUND_P_n = CIBM_MODE_BOUND_P
+ CIBM_TYPE_BOUND_P_n = CIBM_TYPE_BOUND_P
+ CIBM_FORC_BOUND_P_n = CIBM_FORC_BOUND_P
+ XIBM_FORC_BOUND_P_n = XIBM_FORC_BOUND_P
+
+ NIBM_LAYER_Q_n = NIBM_LAYER_Q
+ XIBM_RADIUS_Q_n = XIBM_RADIUS_Q
+ XIBM_POWERS_Q_n = XIBM_POWERS_Q
+ CIBM_MODE_INTE1_Q_n = CIBM_MODE_INTE1_Q
+ CIBM_MODE_INTE3_Q_n = CIBM_MODE_INTE3_Q
+ CIBM_MODE_BOUND_Q_n = CIBM_MODE_BOUND_Q
+ CIBM_TYPE_BOUND_Q_n = CIBM_TYPE_BOUND_Q
+ CIBM_FORC_BOUND_Q_n = CIBM_FORC_BOUND_Q
+ XIBM_FORC_BOUND_Q_n = XIBM_FORC_BOUND_Q
+
+ NIBM_LAYER_R_n = NIBM_LAYER_R
+ XIBM_RADIUS_R_n = XIBM_RADIUS_R
+ XIBM_POWERS_R_n = XIBM_POWERS_R
+ CIBM_MODE_INTE1_R_n = CIBM_MODE_INTE1_R
+ CIBM_MODE_INTE3_R_n = CIBM_MODE_INTE3_R
+ CIBM_MODE_BOUND_R_n = CIBM_MODE_BOUND_R
+ CIBM_TYPE_BOUND_R_n = CIBM_TYPE_BOUND_R
+ CIBM_FORC_BOUND_R_n = CIBM_FORC_BOUND_R
+ XIBM_FORC_BOUND_R_n = XIBM_FORC_BOUND_R
+
+ NIBM_LAYER_S_n = NIBM_LAYER_S
+ XIBM_RADIUS_S_n = XIBM_RADIUS_S
+ XIBM_POWERS_S_n = XIBM_POWERS_S
+ CIBM_MODE_INTE1_S_n = CIBM_MODE_INTE1_S
+ CIBM_MODE_INTE3_S_n = CIBM_MODE_INTE3_S
+ CIBM_MODE_BOUND_S_n = CIBM_MODE_BOUND_S
+ CIBM_TYPE_BOUND_S_n = CIBM_TYPE_BOUND_S
+ CIBM_FORC_BOUND_S_n = CIBM_FORC_BOUND_S
+ XIBM_FORC_BOUND_S_n = XIBM_FORC_BOUND_S
+
+ NIBM_LAYER_T_n = NIBM_LAYER_T
+ XIBM_RADIUS_T_n = XIBM_RADIUS_T
+ XIBM_POWERS_T_n = XIBM_POWERS_T
+ CIBM_MODE_INTE1_T_n = CIBM_MODE_INTE1_T
+ CIBM_MODE_INTE3_T_n = CIBM_MODE_INTE3_T
+ CIBM_MODE_BOUND_T_n = CIBM_MODE_BOUND_T
+ CIBM_TYPE_BOUND_T_n = CIBM_TYPE_BOUND_T
+ CIBM_FORC_BOUND_T_n = CIBM_FORC_BOUND_T
+ XIBM_FORC_BOUND_T_n = XIBM_FORC_BOUND_T
+
+ NIBM_LAYER_E_n = NIBM_LAYER_E
+ XIBM_RADIUS_E_n = XIBM_RADIUS_E
+ XIBM_POWERS_E_n = XIBM_POWERS_E
+ CIBM_MODE_INTE1_E_n = CIBM_MODE_INTE1_E
+ CIBM_MODE_INTE3_E_n = CIBM_MODE_INTE3_E
+ CIBM_MODE_BOUND_E_n = CIBM_MODE_BOUND_E
+ CIBM_TYPE_BOUND_E_n = CIBM_TYPE_BOUND_E
+ CIBM_FORC_BOUND_E_n = CIBM_FORC_BOUND_E
+ XIBM_FORC_BOUND_E_n = XIBM_FORC_BOUND_E
+
+ NIBM_LAYER_V_n = NIBM_LAYER_V
+ XIBM_RADIUS_V_n = XIBM_RADIUS_V
+ XIBM_POWERS_V_n = XIBM_POWERS_V
+ CIBM_MODE_INTE1NV_n = CIBM_MODE_INTE1NV
+ CIBM_MODE_INTE1TV_n = CIBM_MODE_INTE1TV
+ CIBM_MODE_INTE1CV_n = CIBM_MODE_INTE1CV
+ CIBM_MODE_INTE3_V_n = CIBM_MODE_INTE3_V
+ CIBM_MODE_BOUNN_V_n = CIBM_MODE_BOUNN_V
+ CIBM_TYPE_BOUNN_V_n = CIBM_TYPE_BOUNN_V
+ CIBM_MODE_BOUNT_V_n = CIBM_MODE_BOUNT_V
+ CIBM_TYPE_BOUNT_V_n = CIBM_TYPE_BOUNT_V
+ CIBM_MODE_BOUNC_V_n = CIBM_MODE_BOUNC_V
+ CIBM_TYPE_BOUNC_V_n = CIBM_TYPE_BOUNC_V
+ XIBM_FORC_BOUNN_V_n = XIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNN_V_n = CIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNR_V_n = CIBM_FORC_BOUNR_V
+ XIBM_FORC_BOUNT_V_n = XIBM_FORC_BOUNT_V
+ CIBM_FORC_BOUNT_V_n = CIBM_FORC_BOUNT_V
+ XIBM_FORC_BOUNC_V_n = XIBM_FORC_BOUNC_V
+ CIBM_FORC_BOUNC_V_n = CIBM_FORC_BOUNC_V
+
+END SUBROUTINE UPDATE_NAM_IBM_PARAMn
+!------------------------------------------------------------------------------
+END MODULE MODN_IBM_PARAM_n
diff --git a/src/MNH/modn_recycl_paramn.f90 b/src/MNH/modn_recycl_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8689091addeaa41455f5142db0ff32efc5f14ae1
--- /dev/null
+++ b/src/MNH/modn_recycl_paramn.f90
@@ -0,0 +1,117 @@
+!MNH_LIC Copyright 1994-2018 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.
+!
+! #######################
+ MODULE MODN_RECYCL_PARAM_n
+! #######################
+!
+!**** *MODN_RECYCL_PARAM$n* - declaration of namelist NAM_RECYCL_PARAMn
+!
+! PURPOSE
+! -------
+!**** The purpose of this declarative module is to declare the constants
+! allowing to initialize the turbulence recycling method
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! Module MODD_RECYCL_PARAM$n : contains declaration of RECYCLING parameters
+!
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Tim Nagel (Meteo-France)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/02/2021
+!
+USE MODD_RECYCL_PARAM_n, ONLY: &
+ LRECYCL_n => LRECYCL, &
+ LRECYCLN_n => LRECYCLN, &
+ LRECYCLW_n => LRECYCLW, &
+ LRECYCLE_n => LRECYCLE, &
+ LRECYCLS_n => LRECYCLS, &
+ XDRECYCLN_n => XDRECYCLN , &
+ XARECYCLN_n => XARECYCLN , &
+ XDRECYCLW_n => XDRECYCLW , &
+ XARECYCLW_n => XARECYCLW , &
+ XDRECYCLE_n => XDRECYCLE , &
+ XARECYCLE_n => XARECYCLE , &
+ XDRECYCLS_n => XDRECYCLS , &
+ XARECYCLS_n => XARECYCLS , &
+ XTMOY_n => XTMOY, &
+ XTMOYCOUNT_n => XTMOYCOUNT , &
+ XNUMBELT_n => XNUMBELT, &
+ XRCOEFF_n => XRCOEFF, &
+ XTBVTOP_n => XTBVTOP, &
+ XTBVBOT_n => XTBVBOT
+!
+IMPLICIT NONE
+!
+LOGICAL,SAVE :: LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS
+REAL,SAVE :: XDRECYCLN,XARECYCLN,XDRECYCLW,XARECYCLW,XDRECYCLE,XARECYCLE,XDRECYCLS,&
+ XARECYCLS,XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+
+!
+NAMELIST /NAM_RECYCL_PARAMn/ LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS,XDRECYCLW, &
+ XARECYCLW,XDRECYCLN,XARECYCLN,XDRECYCLE,XARECYCLE,XDRECYCLS,&
+ XARECYCLS,XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_RECYCL_PARAMn
+ LRECYCL = LRECYCL_n
+ LRECYCLN = LRECYCLN_n
+ LRECYCLW = LRECYCLW_n
+ LRECYCLE = LRECYCLE_n
+ LRECYCLS = LRECYCLS_n
+ XDRECYCLN = XDRECYCLN_n
+ XARECYCLN = XARECYCLN_n
+ XDRECYCLW = XDRECYCLW_n
+ XARECYCLW = XARECYCLW_n
+ XDRECYCLE = XDRECYCLE_n
+ XARECYCLE = XARECYCLE_n
+ XDRECYCLS = XDRECYCLS_n
+ XARECYCLS = XARECYCLS_n
+ XTMOY = XTMOY_n
+ XTMOYCOUNT = XTMOYCOUNT_n
+ XNUMBELT = XNUMBELT_n
+ XRCOEFF = XRCOEFF_n
+ XTBVTOP = XTBVTOP_n
+ XTBVBOT = XTBVBOT_n
+
+
+END SUBROUTINE INIT_NAM_RECYCL_PARAMn
+
+SUBROUTINE UPDATE_NAM_RECYCL_PARAMn
+ LRECYCL_n = LRECYCL
+ LRECYCLN_n = LRECYCLN
+ LRECYCLW_n = LRECYCLW
+ LRECYCLE_n = LRECYCLE
+ LRECYCLS_n = LRECYCLS
+ XDRECYCLN_n = XDRECYCLN
+ XARECYCLN_n = XARECYCLN
+ XDRECYCLW_n = XDRECYCLW
+ XARECYCLW_n = XARECYCLW
+ XDRECYCLE_n = XDRECYCLE
+ XARECYCLE_n = XARECYCLE
+ XDRECYCLS_n = XDRECYCLS
+ XARECYCLS_n = XARECYCLS
+ XTMOY_n = XTMOY
+ XTMOYCOUNT_n = XTMOYCOUNT
+ XNUMBELT_n = XNUMBELT
+ XRCOEFF_n = XRCOEFF
+ XTBVTOP_n = XTBVTOP
+ XTBVBOT_n = XTBVBOT
+
+
+END SUBROUTINE UPDATE_NAM_RECYCL_PARAMn
+!------------------------------------------------------------------------------
+END MODULE MODN_RECYCL_PARAM_n
+!
diff --git a/src/MNH/modn_stationn.f90 b/src/MNH/modn_stationn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5abbe7c92c81a651353976372e70e9ba1b68375f
--- /dev/null
+++ b/src/MNH/modn_stationn.f90
@@ -0,0 +1,89 @@
+!MNH_LIC Copyright 1994-2014 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.
+!!
+!! #####################
+ MODULE MODN_STATION_n
+!! #####################
+!!
+!!*** *MODN_STATION*
+!!
+!! PURPOSE
+!! -------
+! Namelist to define the stations
+!!
+!!** AUTHOR
+!! ------
+!! E. Jézéquel *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 10/03/20
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_STATION_n
+USE MODD_ALLSTATION_n, ONLY:&
+ NNUMB_STAT_n =>NNUMB_STAT ,&
+ XSTEP_STAT_n =>XSTEP_STAT ,&
+ XX_STAT_n =>XX_STAT ,&
+ XY_STAT_n =>XY_STAT ,&
+ XLAT_STAT_n =>XLAT_STAT ,&
+ XLON_STAT_n =>XLON_STAT ,&
+ XZ_STAT_n =>XZ_STAT ,&
+ CNAME_STAT_n =>CNAME_STAT ,&
+ CTYPE_STAT_n =>CTYPE_STAT ,&
+ CFILE_STAT_n =>CFILE_STAT ,&
+ LDIAG_RESULTS_n =>LDIAG_RESULTS
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+INTEGER ,SAVE:: NNUMB_STAT
+REAL ,SAVE:: XSTEP_STAT
+REAL, DIMENSION(100) ,SAVE:: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+CHARACTER (LEN=7), DIMENSION(100),SAVE:: CNAME_STAT, CTYPE_STAT
+CHARACTER (LEN=20) ,SAVE:: CFILE_STAT !filename
+LOGICAL ,SAVE:: LDIAG_RESULTS
+
+NAMELIST /NAM_STATIONn/ &
+ NNUMB_STAT, XSTEP_STAT, &
+ XX_STAT,XY_STAT,XZ_STAT,&
+ XLON_STAT,XLAT_STAT,&
+ CNAME_STAT,CTYPE_STAT,&
+ CFILE_STAT,LDIAG_RESULTS
+
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_STATIONn
+ NNUMB_STAT = NNUMB_STAT_n
+ XSTEP_STAT = XSTEP_STAT_n
+ XX_STAT = XX_STAT_n
+ XY_STAT = XY_STAT_n
+ XLAT_STAT = XLAT_STAT_n
+ XLON_STAT = XLON_STAT_n
+ XZ_STAT = XZ_STAT_n
+ CNAME_STAT = CNAME_STAT_n
+ CTYPE_STAT = CTYPE_STAT_n
+ CFILE_STAT = CFILE_STAT_n
+ LDIAG_RESULTS= LDIAG_RESULTS_n
+END SUBROUTINE INIT_NAM_STATIONn
+
+SUBROUTINE UPDATE_NAM_STATIONn
+ NNUMB_STAT_n = NNUMB_STAT
+ XSTEP_STAT_n = XSTEP_STAT
+ XX_STAT_n = XX_STAT
+ XY_STAT_n = XY_STAT
+ XLAT_STAT_n = XLAT_STAT
+ XLON_STAT_n = XLON_STAT
+ XZ_STAT_n = XZ_STAT
+ CNAME_STAT_n = CNAME_STAT
+ CTYPE_STAT_n = CTYPE_STAT
+ CFILE_STAT_n = CFILE_STAT
+ LDIAG_RESULTS_n= LDIAG_RESULTS
+END SUBROUTINE UPDATE_NAM_STATIONn
+END MODULE MODN_STATION_n
diff --git a/src/MNH/modn_turbn.f90 b/src/MNH/modn_turbn.f90
index cce15ba12d1d2c0af50d2bf3b19e354608a71eea..96a4b347c6a4022cd86a743b566812addd37c938 100644
--- a/src/MNH/modn_turbn.f90
+++ b/src/MNH/modn_turbn.f90
@@ -56,6 +56,7 @@ USE MODD_TURB_n, ONLY: &
XIMPL_n => XIMPL, &
XKEMIN_n => XKEMIN, &
XCEDIS_n => XCEDIS, &
+ XCADAP_n => XCADAP, &
CTURBLEN_n => CTURBLEN, &
CTURBDIM_n => CTURBDIM, &
LTURB_FLX_n => LTURB_FLX, &
@@ -77,6 +78,7 @@ IMPLICIT NONE
REAL,SAVE :: XIMPL
REAL,SAVE :: XKEMIN
REAL,SAVE :: XCEDIS
+REAL,SAVE :: XCADAP
CHARACTER (LEN=4),SAVE :: CTURBLEN
CHARACTER (LEN=4),SAVE :: CTURBDIM
LOGICAL,SAVE :: LTURB_FLX
@@ -95,7 +97,7 @@ REAL,SAVE :: VSIGQSAT
!
NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
LSUBG_COND,LSIGMAS,LSIG_CONV,LRMC01,CTOM,CSUBG_AUCV,&
- XKEMIN,VSIGQSAT,XCEDIS,CSUBG_AUCV_RI,CCONDENS,&
+ XKEMIN,VSIGQSAT,XCEDIS,XCADAP,CSUBG_AUCV_RI,CCONDENS,&
CLAMBDA3,CSUBG_MF_PDF
!
@@ -105,6 +107,7 @@ SUBROUTINE INIT_NAM_TURBn
XIMPL = XIMPL_n
XKEMIN = XKEMIN_n
XCEDIS = XCEDIS_n
+ XCADAP = XCADAP_n
CTURBLEN = CTURBLEN_n
CTURBDIM = CTURBDIM_n
LTURB_FLX = LTURB_FLX_n
@@ -126,6 +129,7 @@ SUBROUTINE UPDATE_NAM_TURBn
XIMPL_n = XIMPL
XKEMIN_n = XKEMIN
XCEDIS_n = XCEDIS
+ XCADAP_n = XCADAP
CTURBLEN_n = CTURBLEN
CTURBDIM_n = CTURBDIM
LTURB_FLX_n = LTURB_FLX
diff --git a/src/MNH/p_abs.f90 b/src/MNH/p_abs.f90
index f00d38d387a7aac873872ace9711472125d33845..398caa3b9036055871a7e4afbd71f214097f3e95 100644
--- a/src/MNH/p_abs.f90
+++ b/src/MNH/p_abs.f90
@@ -122,6 +122,7 @@ USE MODE_ll
!JUAN
USE MODE_REPRO_SUM
!JUAN
+USE MODD_IBM_PARAM_n, ONLY : XIBM_LS, LIBM, XIBM_EPSI
!
IMPLICIT NONE
!
@@ -350,6 +351,11 @@ ELSEIF( CEQNSYS == 'LHE' ) THEN
ZRTOT(:,:,:) = 0.
END IF
!
+ IF (LIBM) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.-XIBM_EPSI)
+ ZWORK(:,:,:) = PTHVREF(:,:,:)
+ ENDWHERE
+ ENDIF
!
! compute the absolute pressure function
!
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 7bc1e8a89e726cae05875b8cce6aa74eebb2fee0..5b0c9f50b45c371938296c04b5339bb9349bfc65 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -235,6 +235,7 @@ END MODULE MODI_PHYS_PARAM_n
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 21/11/2019: ZRG_HOUR and ZRAT_HOUR are now parameter arrays
!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+!! 02/2021 F.Auguste: add IBM
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -269,6 +270,7 @@ USE MODD_FRC
USE MODD_FRC_n
USE MODD_GRID
USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS, LIBM, XIBM_EPSI
USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
@@ -1172,6 +1174,20 @@ IF (CSURF=='EXTE') THEN
CALL GROUND_PARAM_n(ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
!
+ IF (LIBM) THEN
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
+ ZSFTH(:,:)=0.
+ ZSFRV(:,:)=0.
+ ZSFU (:,:)=0.
+ ZSFV (:,:)=0.
+ ENDWHERE
+ IF (NSV>0) THEN
+ DO JSV = 1 , NSV
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI) ZSFSV(:,:,JSV)=0.
+ ENDDO
+ ENDIF
+ ENDIF
+ !
IF (SIZE(XEMIS)>0) THEN
XDIR_ALB = ZDIR_ALB
XSCA_ALB = ZSCA_ALB
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index 9575e29a70940a45cfa15e31caaab8798c27ec9c..665d038d648d00b933f4ac38adfcd719c352c5b7 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -318,6 +318,7 @@
! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! F. Auguste 02/2021 : add IBM
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
!-------------------------------------------------------------------------------
!
@@ -331,6 +332,8 @@ USE MODD_CONF
USE MODD_CST
USE MODD_GRID
USE MODD_GRID_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+USE MODD_IBM_PARAM_n, ONLY : XIBM_LS
USE MODD_METRICS_n
USE MODD_PGDDIM
USE MODD_PGDGRID
@@ -376,6 +379,7 @@ USE MODE_MSG
!
USE MODI_DEFAULT_DESFM_n ! Interface modules
USE MODI_DEFAULT_EXPRE
+USE MODI_IBM_INIT_LS
USE MODI_READ_HGRID
USE MODI_SHUMAN
USE MODI_SET_RSOU
@@ -602,6 +606,8 @@ NAMELIST/NAM_AERO_PRE/ LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, &
XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, &
NMODE_SLT
!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
!-------------------------------------------------------------------------------
!
!* 0. PROLOGUE
@@ -700,6 +706,8 @@ END IF
CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
+CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
!
CALL INI_FIELD_LIST(1)
!
@@ -1701,7 +1709,27 @@ IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
!
!-------------------------------------------------------------------------------
!
-!* 7. WRITE THE FMFILE
+!* 7. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+IF (LIBM_LSF) THEN
+ !
+ ! In their current state, the IBM can only be used in
+ ! combination with cartesian coordinates and flat orography.
+ !
+ IF ((CZS.NE."FLAT").OR.(.NOT.LCARTESIAN)) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with flat terrain')
+ ENDIF
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. WRITE THE FMFILE
! ----------------
!
CALL SECOND_MNH2(ZTIME1)
@@ -1728,7 +1756,7 @@ XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
-!* 8. EXTERNALIZED SURFACE
+!* 9. EXTERNALIZED SURFACE
! --------------------
!
!
@@ -1803,7 +1831,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 9. CLOSES THE FILE
+!* 10. CLOSES THE FILE
! ---------------
!
IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN
@@ -1817,7 +1845,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 10. PRINTS ON OUTPUT-LISTING
+!* 11. PRINTS ON OUTPUT-LISTING
! ------------------------
!
IF (NVERB >= 5) THEN
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index e0fff03f797676f343c3a395d29916e95f7e1241..d60b32e48fc9308e97812251a8dcf5029ddbc07d 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -383,6 +383,7 @@
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 20/03/2019: missing use MODI_INIT_SALT
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! T.Nagel : 02/2021: add IBM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -402,6 +403,8 @@ USE MODD_GR_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_HURR_CONF
+USE MODD_IBM_LSF, ONLY: LIBM_LSF,CIBM_TYPE, NIBM_SMOOTH,XIBM_SMOOTH
+USE MODD_IBM_PARAM_n
USE MODD_IO, ONLY: TFILEDATA,NIO_VERB,NVERB_DEBUG,TFILE_SURFEX
USE MODD_LBC_n
USE MODD_LSFIELD_n
@@ -440,6 +443,7 @@ USE MODI_DEALLOCATE_MODEL1
USE MODI_DEALLOC_PARA_LL
USE MODI_DEFAULT_DESFM_n
USE MODI_ERROR_ON_TEMPERATURE
+USE MODI_IBM_INIT_LS
USE MODI_INI_PROG_VAR
USE MODI_INIT_SALT
USE MODI_METRICS
@@ -494,6 +498,7 @@ INTEGER :: ILUOUT0 ! logical unit for listing file
INTEGER :: IPRE_REAL1 ! logical unit for namelist file
INTEGER :: IRESP ! return code in FM routines
LOGICAL :: GFOUND ! Return code when searching namelist
+INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
!
REAL :: ZSTART, ZEND, ZTIME1, ZTIME2, ZTOT, ZALL ! for computing time analysis
REAL :: ZMISC, ZREAD, ZHORI, ZPREP, ZSURF, ZTHERMO, ZDYN, ZDIAG, ZWRITE
@@ -534,6 +539,9 @@ XANGCONV0, XANGCONV1000, XANGCONV2000, &
LSALT, CRGUNITS, NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT
NAMELIST/NAM_CH_CONF/ LUSECHAQ,LUSECHIC,LUSECHEM
+!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
! name of dad of input FM file
INTEGER :: II, IJ, IGRID, ILENGTH
CHARACTER (LEN=100) :: HCOMMENT
@@ -692,6 +700,8 @@ CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
+CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
!
! Sea salt
CALL INIT_SALT
@@ -1014,7 +1024,27 @@ CALL SECOND_MNH(ZTIME2)
ZDIAG = ZDIAG + ZTIME2 - ZTIME1
!-------------------------------------------------------------------------------
!
-!* 16. WRITING OF THE MESO-NH FM-FILE
+!* 16. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+CALL GET_DIM_EXT_ll('B',NIU,NJU)
+NKU=NKMAX+2*JPVEXT
+!
+IF (LIBM_LSF) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with cartesian coordinates')
+ ENDIF
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. WRITING OF THE MESO-NH FM-FILE
! ------------------------------
!
ZTIME1 = ZTIME2
@@ -1063,7 +1093,7 @@ ZWRITE = ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
-!* 17. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
+!* 18. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
! -----------------------------------------
!
!* reading in the PGD file
@@ -1083,7 +1113,7 @@ IF (YATMFILETYPE=='MESONH'.AND. YATMFILE/=YPGDFILE) THEN
END IF
!-------------------------------------------------------------------------------
!
-!* 18. INTERPOLATION OF SURFACE VARIABLES
+!* 19. INTERPOLATION OF SURFACE VARIABLES
! ----------------------------------
!
IF (.NOT. LCOUPLING ) THEN
@@ -1108,7 +1138,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 19. EPILOGUE
+!* 20. EPILOGUE
! --------
!
WRITE(ILUOUT0,*)
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index c015ab250313a97dca40978a587656cc6af99196..b16ee01a528d7bd71aba9ca5b816436f885f31eb 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -230,6 +230,7 @@ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_
USE MODD_CST
USE MODD_CONF
USE MODD_DYN_n, ONLY: LRES, XRES
+USE MODD_IBM_PARAM_n, ONLY : XIBM_LS,XIBM_SU,LIBM,NIBM_ITR,XIBM_EPSI
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_MPIF
USE MODD_PARAMETERS
@@ -250,6 +251,7 @@ USE MODI_FLAT_INV
USE MODI_FLAT_INVZ
USE MODI_GDIV
USE MODI_GRADIENT_M
+USE MODI_IBM_BALANCE
USE MODI_MASS_LEAK
USE MODI_P_ABS
USE MODI_RICHARDSON
@@ -422,6 +424,11 @@ END IF
!* 4. COMPUTE THE FORCING TERM FOR THE PRESSURE EQUATION
! --------------------------------------------------
!
+IF (LIBM) THEN
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) PRUS(:,:,:) = 0.
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) PRVS(:,:,:) = 0.
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) PRWS(:,:,:) = 0.
+ENDIF
!
CALL MPPDB_CHECK3D(PRUS,"pressurez 4-before update_halo_ll::PRUS",PRECISION)
CALL MPPDB_CHECK3D(PRVS,"pressurez 4-before update_halo_ll::PRVS",PRECISION)
@@ -438,6 +445,10 @@ CALL MPPDB_CHECK3D(PRWS,"pressurez 4-after update_halo_ll::PRWS",PRECISION)
!
CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
!
+IF (LIBM) THEN
+ CALL IBM_BALANCE(XIBM_LS,XIBM_SU,PRUS,PRVS,PRWS,ZDV_SOURCE)
+ENDIF
+!
! The non-homogenous Neuman problem is transformed in an homogenous Neuman
! problem in the non-periodic cases
IF (HLBCX(1) /= 'CYCL') THEN
@@ -449,6 +460,23 @@ IF (.NOT. L2D .AND. HLBCY(1) /= 'CYCL') THEN
IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = 0.
IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = 0.
ENDIF
+
+IF (LIBM) THEN
+ !
+ IF (HLBCX(1) == 'CYCL') THEN
+ IF (LWEST_ll()) ZDV_SOURCE(IIB-1,:,:) = ZDV_SOURCE(IIB-1,:,:)*XIBM_SU(IIB,:,:,1)
+ IF (LEAST_ll()) ZDV_SOURCE(IIE+1,:,:) = ZDV_SOURCE(IIE+1,:,:)*XIBM_SU(IIE,:,:,1)
+ ENDIF
+ !
+ IF (HLBCY(1) == 'CYCL') THEN
+ IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = ZDV_SOURCE(:,IJB-1,:)*XIBM_SU(:,IJB,:,1)
+ IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = ZDV_SOURCE(:,IJE+1,:)*XIBM_SU(:,IJE,:,1)
+ ENDIF
+ !
+ ZDV_SOURCE(:,:,IKB-1) = ZDV_SOURCE(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)
+ ZDV_SOURCE(:,:,IKE+1) = ZDV_SOURCE(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -476,6 +504,12 @@ IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
ZTHETAV(:,:,:) = PTHT(:,:,:)
END IF
!
+ IF (LIBM) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.-XIBM_EPSI)
+ ZTHETAV(:,:,:) = PTHVREF(:,:,:)
+ ENDWHERE
+ ENDIF
+ !
ZPHIT(:,:,:)=(PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)
!
ELSEIF(CEQNSYS=='LHE') THEN
@@ -484,7 +518,7 @@ ELSEIF(CEQNSYS=='LHE') THEN
!
END IF
!
-IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN) THEN
+IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN .AND. .NOT. LIBM) THEN
! flat cartesian LHE case -> exact solution
IF ( HPRESOPT /= "ZRESI" ) THEN
CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF, &
@@ -528,18 +562,56 @@ END IF
! ----------------------------------------
!
IF ( HLBCX(1) /= 'CYCL' ) THEN
- IF(LWEST_ll()) ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB-1)
- IF(LEAST_ll()) ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB-1)
+ IF(LWEST_ll()) THEN
+! ZPHIT(IIB-1,:, :) = ZPHIT(IIB,:, :)
+ ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB)
+ ZPHIT(IIB-1,:,IKE+1) = ZPHIT(IIB,:,IKE)
+ ENDIF
+ IF(LEAST_ll()) THEN
+! ZPHIT(IIE+1,:, :) = ZPHIT(IIE,:, :)
+ ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB)
+ ZPHIT(IIE+1,:,IKE+1) = ZPHIT(IIE,:,IKE)
+ ENDIF
ENDIF
+!
IF ( HLBCY(1) /= 'CYCL' ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB-1)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB-1)
+ IF (LSOUTH_ll()) THEN
+! ZPHIT(:,IJB-1, :) = ZPHIT(:,IJB, :)
+ ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB)
+ ZPHIT(:,IJB-1,IKE+1) = ZPHIT(:,IJB,IKE)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+! ZPHIT(:,IJE+1, :) = ZPHIT(:,IJE, :)
+ ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB)
+ ZPHIT(:,IJE+1,IKE+1) = ZPHIT(:,IJE,IKE)
+ ENDIF
ENDIF
!
-IF ( L2D ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,:) = ZPHIT(:,IJB,:)
-END IF
+IF (LIBM) THEN
+ !
+ IF ( HLBCX(1) == 'CYCL' ) THEN
+ IF (LWEST_ll()) THEN
+ ZPHIT(IIB-1,:,:) = ZPHIT(IIB,:,:)*(1.-XIBM_SU(IIB,:,:,1))+XIBM_SU(IIB,:,:,1)*ZPHIT(IIB-1,:,:)
+ ENDIF
+ IF (LEAST_ll()) THEN
+ ZPHIT(IIE+1,:,:) = ZPHIT(IIE,:,:)*(1.-XIBM_SU(IIE,:,:,1))+XIBM_SU(IIE,:,:,1)*ZPHIT(IIE+1,:,:)
+ ENDIF
+ ENDIF
+ !
+ IF ( HLBCY(1) == 'CYCL' ) THEN
+ IF (LSOUTH_ll()) THEN
+ ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)*(1.-XIBM_SU(:,IJB,:,1))+XIBM_SU(:,IJB,:,1)*ZPHIT(:,IJB-1,:)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZPHIT(:,IJE+1,:) = ZPHIT(:,IJE,:)*(1.-XIBM_SU(:,IJE,:,1))+XIBM_SU(:,IJE,:,1)*ZPHIT(:,IJE+1,:)
+ ENDIF
+ ENDIF
+ !
+ !-------------Bottom Boundary conditions
+ ZPHIT(:,:,IKB-1) = ZPHIT(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)+(1.-XIBM_SU(:,:,IKB,1))*ZPHIT(:,:,IKB)
+ ZPHIT(:,:,IKE+1) = ZPHIT(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)+(1.-XIBM_SU(:,:,IKE,1))*ZPHIT(:,:,IKE)
+ !
+ENDIF
!
ZDV_SOURCE = GX_M_U(1,IKU,1,ZPHIT,PDXX,PDZZ,PDZX)
!
@@ -638,6 +710,10 @@ CALL CLEANLIST_ll(TZFIELDS2_ll)
! compute the residual divergence
CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
!
+IF (LIBM) THEN
+ ZDV_SOURCE(:,:,:)=ZDV_SOURCE(:,:,:)*XIBM_SU(:,:,:,2)
+ENDIF
+!
IF ( CEQNSYS=='DUR' ) THEN
IF ( SIZE(PRVREF,1) == 0 ) THEN
ZDV_SOURCE=ZDV_SOURCE/PRHODJ/XTH00*PRHODREF*PTHVREF
@@ -679,6 +755,10 @@ IF (OITRADJ) THEN
ENDIF
ENDIF
!
+IF (LIBM) THEN
+ KITR=MIN(NIBM_ITR,KITR)
+ENDIF
+!
!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
! --------------------------------------
!
diff --git a/src/MNH/qlap.f90 b/src/MNH/qlap.f90
index d4da491d97bc6c716267088375a88a11fbeac7cc..4ab81c45c12bf4cfde9030df9730bbf779096637 100644
--- a/src/MNH/qlap.f90
+++ b/src/MNH/qlap.f90
@@ -110,6 +110,7 @@ END MODULE MODI_QLAP
!! 06/12 V.Masson : update_halo due to CONTRAV changes
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! 02/21 F.Auguste : add IBM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -126,6 +127,9 @@ USE MODI_SHUMAN
!
USE MODE_MPPDB
!
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS, LIBM, XIBM_SU
+USE MODI_IBM_BALANCE
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -160,7 +164,7 @@ INTEGER :: IIU,IJU,IKU ! I,J,K array sizes
INTEGER :: JK,JJ,JI ! vertical loop index
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: IINFO_ll
-INTEGER :: IIB,IIE,IJB,IJE
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
!-------------------------------------------------------------------------------
!
!
@@ -170,6 +174,8 @@ INTEGER :: IIB,IIE,IJB,IJE
CALL GET_DIM_EXT_ll('B',IIU,IJU)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKU=SIZE(PY,3)
+IKE = IKU - JPVEXT
+IKB = 1 + JPVEXT
!
ZU = GX_M_U(1,IKU,1,PY,PDXX,PDZZ,PDZX)
CALL MPPDB_CHECK3D(ZU,'QLAP::ZU',PRECISION)
@@ -257,7 +263,26 @@ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZW, 'QLAP::ZW' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!
-CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,ZU,ZV,ZW,PQLAP)
+CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,ZU,ZV,ZW,PQLAP)
+!
+IF (LIBM) THEN
+ !
+ CALL IBM_BALANCE(XIBM_LS,XIBM_SU,ZU,ZV,ZW,PQLAP)
+ !
+ PQLAP(:,:,IKB-1) = PQLAP(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)
+ PQLAP(:,:,IKE+1) = PQLAP(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)
+ !
+ IF ( HLBCX(1) /= 'CYCL' ) THEN
+ IF(LWEST_ll()) PQLAP(IIB-1,:,:) = PQLAP(IIB-1,:,:)*XIBM_SU(IIB,:,:,1)
+ IF(LEAST_ll()) PQLAP(IIE+1,:,:) = PQLAP(IIE+1,:,:)*XIBM_SU(IIE,:,:,1)
+ ENDIF
+ !
+ IF ( HLBCY(1) /= 'CYCL' ) THEN
+ IF (LSOUTH_ll()) PQLAP(:,IJB-1,:) = PQLAP(:,IJB-1,:)*XIBM_SU(:,IJB,:,1)
+ IF (LNORTH_ll()) PQLAP(:,IJE+1,:) = PQLAP(:,IJE+1,:)*XIBM_SU(:,IJE,:,1)
+ ENDIF
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rad_bound.f90 b/src/MNH/rad_bound.f90
index 5c77800b0ba8a034eb63c69e1110d1f71367b3bc..a52f823a01647b3c7b9a9771e4c7d4e0e09515d6 100644
--- a/src/MNH/rad_bound.f90
+++ b/src/MNH/rad_bound.f90
@@ -17,6 +17,7 @@ INTERFACE
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
PTKET,PRUS,PRVS,PRWS )
!
@@ -31,6 +32,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -58,6 +60,7 @@ END MODULE MODI_RAD_BOUND
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
PTKET,PRUS,PRVS,PRWS )
! #################################################################
@@ -152,7 +155,8 @@ END MODULE MODI_RAD_BOUND
!! Lac.C. 2011 : Adaptation to FIT temporal scheme
!! Modification 06/13 (C.Lac) Introduction of cphase_pbl
!! Modification 03/14 (C.Lac) Replacement of XRIMKMAX by XCARPKMAX
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Modification 02/2021 (T.Nagel) Add velocity fluctuations for turbulence recycling purpose
!!
!-------------------------------------------------------------------------------
!
@@ -166,6 +170,7 @@ USE MODD_CTURB
USE MODI_CPHASE_PROFILE
!
USE MODE_ll
+USE MODD_RECYCL_PARAM_n
!
IMPLICIT NONE
!
@@ -185,6 +190,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -289,12 +295,12 @@ SELECT CASE ( HLBCX(1) )
IF ( SIZE(PLBXUS,1) == 0 ) THEN
ZLBEU (:,:) = 0.
ZLBGU (:,:) = PLBXUM(JPHEXT+1,:,:) - PLBXUM(JPHEXT,:,:) ! 2 - 1
- ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) ! 1
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)+PFLUCTUNW*XRCOEFF
ELSE
ZLBEU (:,:) = PLBXUS(JPHEXT,:,:) ! 1
ZLBGU (:,:) = PLBXUM(JPHEXT+1,:,:) - PLBXUM(JPHEXT,:,:) + & ! 2 - 1
PTSTEP * (PLBXUS(JPHEXT+1,:,:) - PLBXUS(JPHEXT,:,:)) ! 2 - 1
- ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) + PTSTEP * PLBXUS(JPHEXT,:,:) ! 1 + 1
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)+ PTSTEP *PLBXUS(JPHEXT,:,:)+PFLUCTUNW*XRCOEFF ! 1 + 1
END IF
!
! ============================================================
@@ -358,12 +364,12 @@ SELECT CASE ( HLBCX(2) )
IF (SIZE(PLBXUS,1) == 0 ) THEN
ZLBEU (:,:) = 0.
ZLBGU (:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) - PLBXUM(ILBX-JPHEXT,:,:) ! ILBX / (ILBX-1
- ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:)
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:)+PFLUCTUNE*XRCOEFF
ELSE
ZLBEU (:,:) = PLBXUS(ILBX-JPHEXT+1,:,:)
ZLBGU (:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) - PLBXUM(ILBX-JPHEXT,:,:) + &
PTSTEP * (PLBXUS(ILBX-JPHEXT+1,:,:) - PLBXUS(ILBX-JPHEXT,:,:))
- ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:)
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:)+PFLUCTUNE*XRCOEFF
END IF
!
! ============================================================
@@ -426,12 +432,12 @@ SELECT CASE ( HLBCY(1) )
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
ZLBGV (:,:) = PLBYVM(:,JPHEXT+1,:) - PLBYVM(:,JPHEXT,:)
- ZLBYV(:,:) = PLBYVM(:,JPHEXT,:)
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:)+PFLUCTVNS*XRCOEFF
ELSE
ZLBEV (:,:) = PLBYVS(:,JPHEXT,:)
ZLBGV (:,:) = PLBYVM(:,JPHEXT+1,:) - PLBYVM(:,JPHEXT,:) + &
PTSTEP * (PLBYVS(:,JPHEXT+1,:) - PLBYVS(:,JPHEXT,:))
- ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:)
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:)+PFLUCTVNS*XRCOEFF
END IF
!
! ============================================================
@@ -494,12 +500,12 @@ SELECT CASE ( HLBCY(2) )
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
ZLBGV (:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) - PLBYVM(:,ILBY-JPHEXT,:)
- ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:)
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:)+PFLUCTVNN*XRCOEFF
ELSE
ZLBEV (:,:) = PLBYVS(:,ILBY-JPHEXT+1,:)
ZLBGV (:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) - PLBYVM(:,ILBY-JPHEXT,:) + &
PTSTEP * (PLBYVS(:,ILBY-JPHEXT+1,:) - PLBYVS(:,ILBY-JPHEXT,:))
- ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP * PLBYVS(:,ILBY-JPHEXT+1,:)
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP *PLBYVS(:,ILBY-JPHEXT+1,:)+PFLUCTVNN*XRCOEFF
END IF
!
! ============================================================
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index 1d99000d85966a7ad56055c2ef086e27006454da..6bd9e3a56a598647f69b7aa413e0d270b849d9ef 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -192,6 +192,9 @@ END MODULE MODI_READ_DESFM_n
!! Modification 02/2018 (Q.Libois) ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification 07/2017 (V. Vionnet) Add blowing snow scheme
+!! Modification 02/2021 (F.Auguste) add IBM
+!! (T.Nagel) add turbulence recycling
+!! (E.Jezequel) add stations read from CSV file
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -260,11 +263,15 @@ USE MODN_LATZ_EDFLX
USE MODN_2D_FRC
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
+USE MODN_STATION_n
!
USE MODN_PARAM_LIMA
!
USE MODE_MSG
USE MODE_POS
+USE MODN_RECYCL_PARAM_n
+USE MODN_IBM_PARAM_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
!
IMPLICIT NONE
!
@@ -434,6 +441,18 @@ IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_DRAGn)
CALL UPDATE_NAM_DRAGn
END IF
+CALL POSNAM(ILUDES,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+CALL INIT_NAM_IBM_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_IBM_PARAMn)
+ CALL UPDATE_NAM_IBM_PARAMn
+END IF
+CALL POSNAM(ILUDES,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+CALL INIT_NAM_RECYCL_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_RECYCL_PARAMn)
+ CALL UPDATE_NAM_RECYCL_PARAMn
+END IF
CALL POSNAM(ILUDES,'NAM_SERIESN',GFOUND,ILUOUT)
CALL INIT_NAM_SERIESn
IF (GFOUND) THEN
@@ -452,6 +471,12 @@ IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLANKn)
CALL UPDATE_NAM_BLANKn
END IF
+CALL POSNAM(ILUDES,'NAM_STATIONN',GFOUND,ILUOUT)
+CALL INIT_NAM_STATIONn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_STATIONn)
+ CALL UPDATE_NAM_STATIONn
+END IF
!
!
IF (KMI == 1) THEN
@@ -686,6 +711,12 @@ IF (NVERB >= 10) THEN
!
WRITE(UNIT=ILUOUT,FMT="('********** DRAGn *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_DRAGn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM FORCING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYLING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
!
WRITE(UNIT=ILUOUT,FMT="('********** NUDGINGn ****************')")
WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index b238faa9ae3a73880848763bf8662d378650c8e5..af4579ccace40b2827fe59bc5ef44c76970a15b3 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -295,6 +295,9 @@ END MODULE MODI_READ_EXSEG_n
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
+! F.Auguste 02/2021: add IBM
+! T.Nagel 02/2021: add turbulence recycling
+! E.Jezequel 02/2021: add stations read from CSV file
! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
@@ -321,11 +324,13 @@ USE MODD_FOREFIRE
#endif
USE MODD_GET_n
USE MODD_GR_FIELD_n
+!USE MODD_IBM_PARAM_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV,NSV_USER_n=>NSV_USER
USE MODD_PARAMETERS
USE MODD_PASPOL
+!USE MODD_RECYCL_PARAM_n
USE MODD_SALT
USE MODD_VAR_ll, ONLY: NPROC
USE MODD_VISCOSITY
@@ -364,6 +369,7 @@ USE MODN_EOL_ALM
USE MODN_FOREFIRE
#endif
USE MODN_FRC
+USE MODN_IBM_PARAM_n
USE MODN_LATZ_EDFLX
USE MODN_LBC_n ! routine is used for each nested model. This has been done
USE MODN_LES
@@ -386,9 +392,11 @@ USE MODN_PARAM_MFSHALL_n
USE MODN_PARAM_n ! realized in subroutine ini_model n
USE MODN_PARAM_RAD_n
USE MODN_PASPOL
+USE MODN_RECYCL_PARAM_n
USE MODN_SALT
USE MODN_SERIES
USE MODN_SERIES_n
+USE MODN_STATION_n
USE MODN_TURB
USE MODN_TURB_CLOUD
USE MODN_TURB_n
@@ -485,10 +493,13 @@ CALL INIT_NAM_NUDGINGN
CALL INIT_NAM_TURBN
CALL INIT_NAM_BLANKN
CALL INIT_NAM_DRAGN
+CALL INIT_NAM_IBM_PARAMN
+CALL INIT_NAM_RECYCL_PARAMN
CALL INIT_NAM_CH_MNHCN
CALL INIT_NAM_CH_SOLVERN
CALL INIT_NAM_SERIESN
CALL INIT_NAM_BLOWSNOWN
+CALL INIT_NAM_STATIONn
!
WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
@@ -519,6 +530,10 @@ CALL POSNAM(ILUSEG,'NAM_TURBN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURBn)
CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
+CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
@@ -539,6 +554,8 @@ CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
+CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
!
IF (KMI == 1) THEN
WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
@@ -1300,6 +1317,8 @@ LUSETKE(KMI) = (CTURB /= 'NONE')
!
!* 2.3 Chemical and NSV_* variables initializations
!
+CALL UPDATE_NAM_IBM_PARAMN
+CALL UPDATE_NAM_RECYCL_PARAMN
CALL UPDATE_NAM_PARAMN
CALL UPDATE_NAM_DYNN
CALL UPDATE_NAM_CONFN
@@ -2933,6 +2952,7 @@ CALL UPDATE_NAM_CH_MNHCN
CALL UPDATE_NAM_CH_SOLVERN
CALL UPDATE_NAM_SERIESN
CALL UPDATE_NAM_BLOWSNOWN
+CALL UPDATE_NAM_STATIONn
!-------------------------------------------------------------------------------
WRITE(UNIT=ILUOUT,FMT='(/)')
!-------------------------------------------------------------------------------
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index cf8b156bf51075f447fce253232fe221c69639f8..4236b545058083091d043272a760ee8976c42953 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -29,7 +29,9 @@ INTERFACE
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD )
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
!
USE MODD_IO, ONLY : TFILEDATA
USE MODD_TIME ! for type DATE_TIME
@@ -115,6 +117,11 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLU
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF,PIBM_XMUT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS
!
!
END SUBROUTINE READ_FIELD
@@ -144,7 +151,9 @@ END MODULE MODI_READ_FIELD
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD )
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
! ########################################################################
!
!!**** *READ_FIELD* - routine to read prognostic and surface fields
@@ -242,8 +251,9 @@ END MODULE MODI_READ_FIELD
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
! M. Leriche 10/06/2019: in restart case read all immersion modes for LIMA
-! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
-!-------------------------------------------------------------------------------
+!! F. Auguste 02/2021: add fields necessary for IBM
+!! T. Nagel 02/2021: add fields necessary for turbulence recycling
+!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -260,11 +270,12 @@ USE MODD_CST
USE MODD_CTURB
USE MODD_DUST
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
-use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEREAL
+use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEREAL,TYPELOG,TYPEINT
USE MODD_FIELD_n, only: XZWS_DEFAULT
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
+USE MODD_IBM_PARAM_n, ONLY: LIBM
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
@@ -280,6 +291,7 @@ USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
USE MODD_PARAM_n, ONLY: CSCONV
USE MODD_PASPOL
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_RECYCL_PARAM_n
USE MODD_SALT
USE MODD_TIME ! for type DATE_TIME
!
@@ -382,6 +394,12 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLU
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF ! LSF for IBM
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_XMUT ! Turbulent viscosity
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW ! Velocity average at West boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN ! Velocity average at North boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE ! Velocity average at East boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS ! Velocity average at South boundary
!
!* 0.2 declarations of local variables
!
@@ -394,6 +412,7 @@ INTEGER :: JKLOOP,JRR ! Loop indexes
INTEGER :: IIUP,IJUP ! size of working window arrays
INTEGER :: JT ! loop index
LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
+LOGICAL :: ZLRECYCL ! switch if turbulence recycling is activated
CHARACTER(LEN=2) :: INDICE
CHARACTER(LEN=3) :: YFRC ! To mark the different forcing dates
CHARACTER(LEN=15) :: YVAL
@@ -587,6 +606,201 @@ SELECT CASE(HGETCIT) ! ice concentration
PCIT(:,:,:)=0.
END SELECT
!
+IF (LIBM .AND. CPROGRAM=='MESONH') THEN
+ !
+ TZFIELD%CMNHNAME = 'LSFP'
+ TZFIELD%CLONGNAME = 'LSFP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_LSF)
+ !
+ TZFIELD%CMNHNAME = 'XMUT'
+ TZFIELD%CLONGNAME = 'XMUT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm2.s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_XMUT)
+ !
+ENDIF
+!
+ZLRECYCL=.FALSE.
+TZFIELD%CMNHNAME = 'RECYCLING'
+TZFIELD%CLONGNAME = 'RECYCLING'
+TZFIELD%CSTDNAME = ''
+TZFIELD%CUNITS = ''
+TZFIELD%CDIR = ''
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPELOG
+TZFIELD%NDIMS = 0
+TZFIELD%LTIMEDEP = .FALSE.
+CALL IO_Field_read(TPINIFILE,TZFIELD,ZLRECYCL)
+IF (ZLRECYCL) THEN
+ !
+ TZFIELD%CMNHNAME = 'RCOUNT'
+ TZFIELD%CLONGNAME = 'RCOUNT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEINT
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,R_COUNT)
+ !
+ IF (R_COUNT .NE. 0) THEN
+ IF (LRECYCLW) THEN
+ TZFIELD%CMNHNAME = 'URECYCLW'
+ TZFIELD%CLONGNAME = 'URECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANW)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLW'
+ TZFIELD%CLONGNAME = 'VRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANW)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLW'
+ TZFIELD%CLONGNAME = 'WRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANW)
+ !
+ ENDIF
+ IF (LRECYCLN) THEN
+ TZFIELD%CMNHNAME = 'URECYCLN'
+ TZFIELD%CLONGNAME = 'URECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANN)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLN'
+ TZFIELD%CLONGNAME = 'VRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANN)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLN'
+ TZFIELD%CLONGNAME = 'WRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANN)
+ !
+ ENDIF
+ IF (LRECYCLE) THEN
+ TZFIELD%CMNHNAME = 'URECYCLE'
+ TZFIELD%CLONGNAME = 'URECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANE)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLE'
+ TZFIELD%CLONGNAME = 'VRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANE)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLE'
+ TZFIELD%CLONGNAME = 'WRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANE)
+ !
+ ENDIF
+ IF (LRECYCLS) THEN
+ TZFIELD%CMNHNAME = 'URECYCLS'
+ TZFIELD%CLONGNAME = 'URECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANS)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLS'
+ TZFIELD%CLONGNAME = 'VRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANS)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLS'
+ TZFIELD%CLONGNAME = 'WRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANS)
+ ENDIF
+ ENDIF
+ENDIF
+!
! Scalar Variables Reading : Users, C2R2, C1R3, LIMA, ELEC, Chemical SV
!
ISV= SIZE(PSVT,4)
diff --git a/src/MNH/recycl_fluc.f90 b/src/MNH/recycl_fluc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f4153f58c53b26754fa7d7dd7bdae006998a0685
--- /dev/null
+++ b/src/MNH/recycl_fluc.f90
@@ -0,0 +1,492 @@
+!MNH_LIC Copyright 1994-2014 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.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_RECYCL_FLUC
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+ INTEGER ,INTENT(IN) :: OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTABU,PPTABV,PPTABW,PTHT,PDZZ
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+
+END SUBROUTINE RECYCL_FLUC
+!
+END INTERFACE
+!
+END MODULE MODI_RECYCL_FLUC
+!
+!
+!
+! ####################################
+ SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+! ####################################
+!
+!!**** *RECYCL_FLUC* - routine calculating the velocity forcing fluctuations
+!
+!!
+!! PURPOSE
+!! -------
+! RECYCLING METHOD
+!
+!! METHOD
+!! ------
+!!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Tim Nagel * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+! module
+USE MODE_POS
+USE MODE_ll
+USE MODE_IO
+USE MODI_SHUMAN
+!
+! declaration
+USE MODD_VAR_ll, ONLY: IP, NPROC
+USE MODD_CONF, ONLY: NHALO
+!
+USE MODD_RECYCL_PARAM_n
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_CST
+!
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_METRICS_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_DYN_n
+USE MODD_FIELD_n
+USE MODD_CURVCOR_n
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODE_GRIDPROJ
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_REF
+USE MODD_LATZ_EDFLX
+!
+USE MODI_MEAN_Z
+!
+IMPLICIT NONE
+!
+!------------------------------------------------------------------------------
+!
+! 0.1 declarations of arguments
+ INTEGER ,INTENT(IN) :: OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTABU,PPTABV,PPTABW,PTHT,PDZZ
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+!
+!------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: IIU,IJU,IKU,IIP,JJ,JI,JK,IIB,IJB,IIE,IJE,IKE,IKB
+INTEGER :: ICOUNT,JCOUNT,IIMAX_ll,IJMAX_ll
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUTN,ZTMPVNN,ZTMPWTN !Velocity in the recycling Plan, NORTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUTN,ZTMPFVNN,ZTMPFWTN !Fluctuations in the recycling Plan, NORTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUNW,ZTMPVTW,ZTMPWTW !Velocity in the recycling Plan, WEST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUNW,ZTMPFVTW,ZTMPFWTW !Fluctuations in the recycling Plan, WEST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUNE,ZTMPVTE,ZTMPWTE !Velocity in the recycling Plan EAST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUNE,ZTMPFVTE,ZTMPFWTE !Fluctuations in the recycling Plan, EAST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUTS,ZTMPVNS,ZTMPWTS !Velocity in the recycling Plan, SOUTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUTS,ZTMPFVNS,ZTMPFWTS !Fluctuations in the recycling Plan, SOUTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPZ
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZALPNORTH,ZALPWEST,ZALPSOUTH,ZALPEAST !Coefficient for the fluctuation (ZALP IN [0-1])
+REAL, DIMENSION(:,:) ,ALLOCATABLE :: ZTMPNDW,ZTMPNDN,ZTMPNDE,ZTMPNDS !Brunt Vaisala frequency
+REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZND,ZWORK32 !Brunt Vaisala frequency (3D fields)
+INTEGER :: IINFO_ll
+
+!------------------------------------------------------------------------------
+!
+! *** Allocation and dimension
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+IKU = SIZE(PPTABU,3)
+IKE=IKU-JPVEXT
+IKB = 1 + JPVEXT
+
+ALLOCATE(ZWORK32(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ALLOCATE(ZND(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+
+!
+! *** Dry Brunt Vaisala frequency
+!
+ZWORK32(:,:,:)=DZM(PTHT(:,:,:))/ MZM(PTHT(:,:,:))
+DO JK=1,(IKE+1)
+ DO JJ=1,(IJE+1)
+ DO JI=1,(IIE+1)
+ IF(ZWORK32(JI,JJ,JK)<0.) THEN
+ ZND(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ PDZZ(JI,JJ,JK) ))
+ ELSE
+ ZND(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ PDZZ(JI,JJ,JK) ) )
+ ENDIF
+ ENDDO
+ ENDDO
+ENDDO
+ZND(:,:,:) = ABS(ZND(:,:,:))
+DO JK=1,(IKE+1)
+ DO JJ=1,(IJE+1)
+ DO JI=1,(IIE+1)
+ IF(ZND(JI,JJ,JK)>1.E6) THEN
+ ZND(JI,JJ,JK)= 1.E6
+ ELSEIF(ZND(JI,JJ,JK)<1.E-6) THEN
+ ZND(JI,JJ,JK)= 1.E-6
+ ENDIF
+ ZND(JI,JJ,JK) = 1./ZND(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+IF (LWEST_ll ()) ZND(IIB-1,:,:)=ZND(IIB,:,:)
+IF (LNORTH_ll()) ZND(:,IJE+1,:)=ZND(:,IJE,:)
+IF (LEAST_ll ()) ZND(IIE+1,:,:)=ZND(IIE,:,:)
+IF (LSOUTH_ll()) ZND(:,IJB-1,:)=ZND(:,IJB,:)
+ZND(:,:,IKE+1)=ZND(:,:,IKE)
+ZND(:,:,IKB-1)=ZND(:,:,IKB)
+
+
+IF (LRECYCLW) THEN
+ !-------------------------------------------------------
+ !-----------WEST
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUNW (IJU,IKU))
+ ALLOCATE(ZTMPVTW (IJU,IKU))
+ ALLOCATE(ZTMPWTW (IJU,IKU))
+ ALLOCATE(ZTMPZ (IJU,IKU))
+ ALLOCATE(ZTMPNDW (IJU,IKU))
+ ALLOCATE(ZALPWEST (IJU,IKU))
+ ALLOCATE(ZTMPFUNW (IJU,IKU))
+ ALLOCATE(ZTMPFVTW (IJU,IKU))
+ ALLOCATE(ZTMPFWTW (IJU,IKU))
+ ZTMPUNW =0.
+ ZTMPVTW =0.
+ ZTMPWTW =0.
+ ZTMPZ =0.
+ ZTMPNDW =0.
+ ZALPWEST=0.
+ CALL GET_2DSLICE_ll(PPTABU,'Y',PMINW,ZTMPUNW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'Y',PMINW,ZTMPVTW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'Y',PMINW,ZTMPWTW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'Y',PMINW,ZTMPZ(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'Y',1+JPHEXT,ZTMPNDW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=OR_COUNT/XTMOYCOUNT
+ XUMEANW(:,:,ICOUNT)=ZTMPUNW(:,:)
+ XVMEANW(:,:,ICOUNT)=ZTMPVTW(:,:)
+ XWMEANW(:,:,ICOUNT)=ZTMPWTW(:,:)
+ ENDIF
+ IF(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANW(:,:,JCOUNT)=XUMEANW(:,:,JCOUNT+1)
+ XVMEANW(:,:,JCOUNT)=XVMEANW(:,:,JCOUNT+1)
+ XWMEANW(:,:,JCOUNT)=XWMEANW(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANW(:,:,INT(XNUMBELT))=ZTMPUNW(:,:)
+ XVMEANW(:,:,INT(XNUMBELT))=ZTMPVTW(:,:)
+ XWMEANW(:,:,INT(XNUMBELT))=ZTMPWTW(:,:)
+ ENDIF
+ IF (LWEST_ll( )) THEN
+ DO JJ = 1,IJU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDW(JJ,JK)>XTBVTOP) THEN
+ ZALPWEST(JJ,JK)=1.
+ ELSE IF (ZTMPNDW(JJ,JK)<XTBVBOT) THEN
+ ZALPWEST(JJ,JK)=0.
+ ELSE
+ ZALPWEST(JJ,JK)=1./ABS(XTBVTOP-XTBVBOT)*ABS(ZTMPNDW(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(R_COUNT.GT.XTMOY) THEN
+ ZTMPFUNW =ZTMPUNW(:,:)-(SUM(XUMEANW,DIM=3)/INT(XNUMBELT))
+ ZTMPFVTW =ZTMPVTW(:,:)-(SUM(XVMEANW,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTW =ZTMPWTW(:,:)-(SUM(XWMEANW,DIM=3)/INT(XNUMBELT))
+ PFLUCTUNW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUNW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTVTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPUNW,ZTMPVTW,ZTMPWTW,ZTMPZ,ZTMPNDW,ZALPWEST,ZTMPFUNW,ZTMPFVTW,ZTMPFWTW)
+ENDIF
+
+IF (LRECYCLN) THEN
+ !-------------------------------------------------------
+ !-----------NORTH
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUTN (IIU,IKU))
+ ALLOCATE(ZTMPVNN (IIU,IKU))
+ ALLOCATE(ZTMPWTN (IIU,IKU))
+ ALLOCATE(ZTMPZ (IIU,IKU))
+ ALLOCATE(ZTMPNDN (IIU,IKU))
+ ALLOCATE(ZALPNORTH (IIU,IKU))
+ ALLOCATE(ZTMPFUTN (IIU,IKU))
+ ALLOCATE(ZTMPFVNN (IIU,IKU))
+ ALLOCATE(ZTMPFWTN (IIU,IKU))
+ ZTMPUTN =0.
+ ZTMPVNN =0.
+ ZTMPWTN =0.
+ ZTMPZ =0.
+ ZTMPNDN =0.
+ ZALPNORTH=0.
+ CALL GET_2DSLICE_ll(PPTABU,'X',PMINN,ZTMPUTN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'X',PMINN,ZTMPVNN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'X',PMINN,ZTMPWTN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'X',PMINN,ZTMPZ(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'X',IJMAX_ll+JPHEXT,ZTMPNDN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=OR_COUNT/XTMOYCOUNT
+ XUMEANN(:,:,ICOUNT)=ZTMPUTN(:,:)
+ XVMEANN(:,:,ICOUNT)=ZTMPVNN(:,:)
+ XWMEANN(:,:,ICOUNT)=ZTMPWTN(:,:)
+ ENDIF
+ IF(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANN(:,:,JCOUNT)=XUMEANN(:,:,JCOUNT+1)
+ XVMEANN(:,:,JCOUNT)=XVMEANN(:,:,JCOUNT+1)
+ XWMEANN(:,:,JCOUNT)=XWMEANN(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANN(:,:,INT(XNUMBELT))=ZTMPUTN(:,:)
+ XVMEANN(:,:,INT(XNUMBELT))=ZTMPVNN(:,:)
+ XWMEANN(:,:,INT(XNUMBELT))=ZTMPWTN(:,:)
+ ENDIF
+
+ IF (LNORTH_ll( )) THEN
+ DO JJ = 1,IIU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDN(JJ,JK)>XTBVTOP) THEN
+ ZALPNORTH(JJ,JK)=1.
+ ELSE IF (ZTMPNDN(JJ,JK)<XTBVBOT) THEN
+ ZALPNORTH(JJ,JK)=0.
+ ELSE
+ ZALPNORTH(JJ,JK)=1./(XTBVTOP-XTBVBOT)*(ZTMPNDN(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(R_COUNT.GT.XTMOY) THEN
+ ZTMPFUTN =ZTMPUTN(:,:)-(SUM(XUMEANN,DIM=3)/INT(XNUMBELT))
+ ZTMPFVNN =ZTMPVNN(:,:)-(SUM(XVMEANN,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTN =ZTMPWTN(:,:)-(SUM(XWMEANN,DIM=3)/INT(XNUMBELT))
+ PFLUCTVNN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVNN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTUTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPVNN,ZTMPUTN,ZTMPWTN,ZTMPZ,ZTMPNDN,ZALPNORTH,ZTMPFVNN,ZTMPFUTN,ZTMPFWTN)
+ENDIF
+
+IF (LRECYCLE) THEN
+ !-------------------------------------------------------
+ !-----------EAST
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUNE (IJU,IKU))
+ ALLOCATE(ZTMPVTE (IJU,IKU))
+ ALLOCATE(ZTMPWTE (IJU,IKU))
+ ALLOCATE(ZTMPZ (IJU,IKU))
+ ALLOCATE(ZTMPNDE (IJU,IKU))
+ ALLOCATE(ZALPEAST (IJU,IKU))
+ ALLOCATE(ZTMPFUNE (IJU,IKU))
+ ALLOCATE(ZTMPFVTE (IJU,IKU))
+ ALLOCATE(ZTMPFWTE (IJU,IKU))
+ ZTMPUNE =0.
+ ZTMPVTE =0.
+ ZTMPWTE =0.
+ ZTMPZ =0.
+ ZTMPNDE =0.
+ ZALPEAST=0.
+ CALL GET_2DSLICE_ll(PPTABU,'Y',PMINE,ZTMPUNE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'Y',PMINE,ZTMPVTE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'Y',PMINE,ZTMPWTE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'Y',PMINE,ZTMPZ(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'Y',IIMAX_ll+JPHEXT,ZTMPNDE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=OR_COUNT/XTMOYCOUNT
+ XUMEANE(:,:,ICOUNT)=ZTMPUNE(:,:)
+ XVMEANE(:,:,ICOUNT)=ZTMPVTE(:,:)
+ XWMEANE(:,:,ICOUNT)=ZTMPWTE(:,:)
+ ENDIF
+ IF(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANE(:,:,JCOUNT)=XUMEANE(:,:,JCOUNT+1)
+ XVMEANE(:,:,JCOUNT)=XVMEANE(:,:,JCOUNT+1)
+ XWMEANE(:,:,JCOUNT)=XWMEANE(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANE(:,:,INT(XNUMBELT))=ZTMPUNE(:,:)
+ XVMEANE(:,:,INT(XNUMBELT))=ZTMPVTE(:,:)
+ XWMEANE(:,:,INT(XNUMBELT))=ZTMPWTE(:,:)
+ ENDIF
+ IF (LEAST_ll( )) THEN
+ DO JJ = 1,IJU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDE(JJ,JK)>XTBVTOP) THEN
+ ZALPEAST(JJ,JK)=1.
+ ELSE IF (ZTMPNDE(JJ,JK)<XTBVBOT) THEN
+ ZALPEAST(JJ,JK)=0.
+ ELSE
+ ZALPEAST(JJ,JK)=1./ABS(XTBVTOP-XTBVBOT)*ABS(ZTMPNDE(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(R_COUNT.GT.XTMOY) THEN
+ ZTMPFUNE =ZTMPUNE(:,:)-(SUM(XUMEANE,DIM=3)/INT(XNUMBELT))
+ ZTMPFVTE =ZTMPVTE(:,:)-(SUM(XVMEANE,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTE =ZTMPWTE(:,:)-(SUM(XWMEANE,DIM=3)/INT(XNUMBELT))
+ PFLUCTUNE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUNE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTVTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPUNE,ZTMPVTE,ZTMPWTE,ZTMPZ,ZTMPNDE,ZALPEAST,ZTMPFUNE,ZTMPFVTE,ZTMPFWTE)
+ENDIF
+!
+IF (LRECYCLS) THEN
+ !-------------------------------------------------------
+ !-----------SOUTH
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUTS (IIU,IKU))
+ ALLOCATE(ZTMPVNS (IIU,IKU))
+ ALLOCATE(ZTMPWTS (IIU,IKU))
+ ALLOCATE(ZTMPZ (IIU,IKU))
+ ALLOCATE(ZTMPNDS (IIU,IKU))
+ ALLOCATE(ZALPSOUTH (IIU,IKU))
+ ALLOCATE(ZTMPFUTS (IIU,IKU))
+ ALLOCATE(ZTMPFVNS (IIU,IKU))
+ ALLOCATE(ZTMPFWTS (IIU,IKU))
+ ZTMPUTS =0.
+ ZTMPVNS =0.
+ ZTMPWTS =0.
+ ZTMPZ =0.
+ ZTMPNDS =0.
+ ZALPSOUTH=0.
+ CALL GET_2DSLICE_ll(PPTABU,'X',PMINS,ZTMPUTS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'X',PMINS,ZTMPVNS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'X',PMINS,ZTMPWTS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'X',PMINS,ZTMPZ(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'X',1+JPHEXT,ZTMPNDS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=OR_COUNT/XTMOYCOUNT
+ XUMEANS(:,:,ICOUNT)=ZTMPUTS(:,:)
+ XVMEANS(:,:,ICOUNT)=ZTMPVNS(:,:)
+ XWMEANS(:,:,ICOUNT)=ZTMPWTS(:,:)
+ ENDIF
+ IF(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANS(:,:,JCOUNT)=XUMEANS(:,:,JCOUNT+1)
+ XVMEANS(:,:,JCOUNT)=XVMEANS(:,:,JCOUNT+1)
+ XWMEANS(:,:,JCOUNT)=XWMEANS(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANS(:,:,INT(XNUMBELT))=ZTMPUTS(:,:)
+ XVMEANS(:,:,INT(XNUMBELT))=ZTMPVNS(:,:)
+ XWMEANS(:,:,INT(XNUMBELT))=ZTMPWTS(:,:)
+ ENDIF
+ IF (LSOUTH_ll( )) THEN
+ DO JJ = 1,IIU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDS(JJ,JK)>XTBVTOP) THEN
+ ZALPSOUTH(JJ,JK)=1.
+ ELSE IF (ZTMPNDS(JJ,JK)<XTBVBOT) THEN
+ ZALPSOUTH(JJ,JK)=0.
+ ELSE
+ ZALPSOUTH(JJ,JK)=1./(XTBVTOP-XTBVBOT)*(ZTMPNDS(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(R_COUNT.GT.XTMOY) THEN
+ ZTMPFUTS =ZTMPUTS(:,:)-(SUM(XUMEANS,DIM=3)/INT(XNUMBELT))
+ ZTMPFVNS =ZTMPVNS(:,:)-(SUM(XVMEANS,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTS =ZTMPWTS(:,:)-(SUM(XWMEANS,DIM=3)/INT(XNUMBELT))
+ PFLUCTVNS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVNS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTUTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPVNS,ZTMPUTS,ZTMPWTS,ZTMPZ,ZTMPNDS,ZALPSOUTH,ZTMPFVNS,ZTMPFUTS,ZTMPFWTS)
+ENDIF
+
+DEALLOCATE(ZWORK32,ZND)
+
+RETURN
+
+END SUBROUTINE RECYCL_FLUC
diff --git a/src/MNH/recycling.f90 b/src/MNH/recycling.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5e71b84303a8bdc17967af912385a5f979ad6fe2
--- /dev/null
+++ b/src/MNH/recycling.f90
@@ -0,0 +1,191 @@
+!MNH_LIC Copyright 1994-2014 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.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_RECYCLING
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE RECYCLING (PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS, &
+ PTCOUNT)
+
+ INTEGER ,INTENT(IN) :: PTCOUNT
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+
+END SUBROUTINE RECYCLING
+!
+END INTERFACE
+!
+END MODULE MODI_RECYCLING
+!
+!
+!
+! ####################################
+ SUBROUTINE RECYCLING (PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS, &
+ PTCOUNT)
+! ####################################
+!
+!!**** *RECYCLING* - routine initializing and building the velocity fluctuations fields
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize and calculate
+! turbulent fluctuations in order to be applied at the domain
+! boundaries.
+!
+!! METHOD
+!! ------
+!!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Tim Nagel * Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+! module
+USE MODE_POS
+USE MODE_ll
+USE MODE_IO
+!USE MODI_SHUMAN
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_CST
+!
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_METRICS_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_DYN_n
+USE MODD_FIELD_n
+USE MODD_CURVCOR_n
+USE MODD_REF
+!
+USE MODD_VAR_ll, ONLY: IP, NPROC
+USE MODD_RECYCL_PARAM_n
+USE MODI_RECYCL_FLUC
+USE MODD_LUNIT_n, ONLY : TLUOUT
+!
+IMPLICIT NONE
+!
+!------------------------------------------------------------------------------
+!
+! 0.1 declarations of arguments
+INTEGER ,INTENT(IN) :: PTCOUNT ! temporal loop index of model KMODEL
+REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+!
+!------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: IIU,IJU,IKU,JCOUNT,ICOUNT,ILUOUT
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE,IIP
+INTEGER :: IIBG,IIEG,IJBG,IJEG,IIMAX,IJMAX
+INTEGER :: PMINW,PMINE,PMINN,PMINS
+INTEGER :: JIDIST,JJDIST
+REAL :: Z_DELTX,Z_DELTY
+!
+!------------------------------------------------------------------------------
+!
+! 0.3 allocation
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=NKMAX+2*JPVEXT
+PMINW=0
+PMINN=0
+PMINS=0
+PMINE=0
+
+CALL GET_OR_ll('B',IIBG,IJBG)
+IIBG = IIBG+IIB-1
+IJBG = IJBG+IJB-1
+CALL GET_GLOBALDIMS_ll( IIMAX,IJMAX)
+IIEG=IIBG+IIE-IIB
+IJEG=IJBG+IJE-IJB
+Z_DELTX = XXHAT(2)-XXHAT(1)
+Z_DELTY = XYHAT(2)-XYHAT(1)
+
+
+ILUOUT = TLUOUT%NLU
+!------------------------------------------------------------------------------
+!
+!**** 1. Recycling distance calculation
+! ---------------
+!
+!Moving averaged parameter verification
+IF (PTCOUNT==1 .AND. INT(XTMOY)/INT(XTMOYCOUNT) /= INT(XNUMBELT)) THEN
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*) ' ERROR : XTMOY/XTMOYCOUNT must be equal to XNUMBELT'
+ WRITE(ILUOUT,FMT=*) ' Please change the above parameters accordingly in NAM_RECYCL_PARAMn'
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*) ' MESONH STOP'
+ WRITE(ILUOUT,FMT=*) '###############'
+ WRITE(ILUOUT,FMT=*)
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RECYCLING','XTMOY/XTMOYCOUNT must be equal to XNUMBELT')
+END IF
+
+IF(CCONF == "RESTA" .AND. PTCOUNT == 1 ) THEN
+ R_COUNT = R_COUNT
+ELSE
+ R_COUNT = R_COUNT +1
+ !IF (IP==1) WRITE(*,*)'RCOUNT: ', R_COUNT
+ENDIF
+
+ IF (LRECYCLW) THEN
+ JIDIST = INT(XDRECYCLW*cos(XARECYCLW)/Z_DELTX)
+ JJDIST = INT(XDRECYCLW*sin(XARECYCLW)/Z_DELTY)
+ PMINW = 1+JPHEXT+JIDIST
+ ENDIF
+ IF (LRECYCLN) THEN
+ JIDIST = INT(XDRECYCLN*cos(XARECYCLN)/Z_DELTX)
+ JJDIST = INT(XDRECYCLN*sin(XARECYCLN)/Z_DELTY)
+ PMINN = 1+JPHEXT+JJDIST
+ ENDIF
+ IF (LRECYCLE) THEN
+ JIDIST = INT(XDRECYCLE*cos(XARECYCLE)/Z_DELTX)
+ JJDIST = INT(XDRECYCLE*sin(XARECYCLE)/Z_DELTY)
+ PMINE = 1+JPHEXT+JIDIST
+ ENDIF
+ IF (LRECYCLS) THEN
+ JIDIST = INT(XDRECYCLS*cos(XARECYCLS)/Z_DELTX)
+ JJDIST = INT(XDRECYCLS*sin(XARECYCLS)/Z_DELTY)
+ PMINS = 1+JPHEXT+JJDIST!
+ ENDIF
+
+ CALL RECYCL_FLUC (XUT,XVT,XWT,XTHT,XDZZ,R_COUNT,PTCOUNT,PMINW,PMINN,PMINE,PMINS,&
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN,&
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+RETURN
+
+END SUBROUTINE RECYCLING
+
diff --git a/src/MNH/station_reader.f90 b/src/MNH/station_reader.f90
new file mode 100644
index 0000000000000000000000000000000000000000..611cb4f601b073656f0a0925bc3b3fc0cd306df0
--- /dev/null
+++ b/src/MNH/station_reader.f90
@@ -0,0 +1,157 @@
+!MNH_LIC Copyright 1994-2014 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.
+! #######################
+ MODULE MODI_STATION_READER
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE READ_CSV_STATION(KLUNAM,HFILE,TPSTATION,OCARTESIAN)
+ USE MODD_ALLSTATION_n
+ USE MODD_STATION_n
+ USE MODD_PARAMETERS
+ USE MODD_TYPE_STATION
+ USE MODI_INI_SURFSTATION_n
+ INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(STATION), INTENT(OUT) :: TPSTATION ! stored blade data
+ LOGICAL, INTENT(IN) :: OCARTESIAN
+END SUBROUTINE READ_CSV_STATION
+!
+END INTERFACE
+!
+END MODULE MODI_STATION_READER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_READER* -
+!!
+!! PURPOSE
+!! -------
+!! Prescribe probes through a CSV file
+!!
+!! AUTHOR
+!! ------
+!! E. Jézéquel *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 03/2020 Original
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE READ_CSV_STATION(KLUNAM,HFILE,TPSTATION,OCARTESIAN)
+USE MODD_ALLSTATION_n
+USE MODD_STATION_n
+USE MODD_PARAMETERS
+USE MODD_TYPE_STATION
+USE MODI_INI_SURFSTATION_n
+
+!
+INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(STATION), INTENT(INOUT) :: TPSTATION ! dummy stored
+LOGICAL, INTENT(IN) :: OCARTESIAN
+!
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=80) :: YERROR
+CHARACTER(LEN=400) :: YSTRING
+!
+
+! Open file
+OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted')
+! Count lines
+REWIND(KLUNAM)
+INBLINE=0
+DO
+ READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+!* analyses if the record has been written in French convention
+ CALL FRENCH_TO_ENGLISH(YSTRING) ! analyse de convention fr ou eng
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+ IF (INBLINE == 0) THEN
+ YERROR = 'Data not found in file : '//TRIM(HFILE)
+ PRINT*, YERROR
+ ELSE
+ ! Save number of station
+ NUMBSTAT = INBLINE - 1
+ !
+ ! Allocation des tableaux
+ ALLOCATE(TPSTATION%LAT(NUMBSTAT))
+ ALLOCATE(TPSTATION%LON(NUMBSTAT))
+ ALLOCATE(TPSTATION%X(NUMBSTAT))
+ ALLOCATE(TPSTATION%Y(NUMBSTAT))
+ ALLOCATE(TPSTATION%Z(NUMBSTAT))
+ ALLOCATE(TPSTATION%K(NUMBSTAT))
+ !ALLOCATE(TPSTATION%STEP(NUMBSTAT))
+ ALLOCATE(TPSTATION%NAME(NUMBSTAT))
+ ALLOCATE(TPSTATION%TYPE(NUMBSTAT))
+
+ TPSTATION%LON = XUNDEF
+ TPSTATION%LAT = XUNDEF
+ TPSTATION%Z = XUNDEF
+ TPSTATION%K = XUNDEF
+ TPSTATION%X = XUNDEF
+ TPSTATION%Y = XUNDEF
+ TPSTATION%NAME = " "
+ TPSTATION%TYPE = " "
+ ! Nouvelle lecture
+ REWIND(KLUNAM)
+ READ(KLUNAM,FMT='(A400)') YSTRING ! Lecture du header
+ !
+ ! Save the data
+ IF (OCARTESIAN) THEN
+ INBLINE = 1
+ DO INBLINE=1, NUMBSTAT
+ READ(KLUNAM,FMT='(A400)') YSTRING
+ READ(YSTRING,*) TPSTATION%NAME(INBLINE),TPSTATION%TYPE(INBLINE),&
+ TPSTATION%X(INBLINE), TPSTATION%Y(INBLINE), TPSTATION%Z(INBLINE)!,&
+ END DO
+ REWIND(KLUNAM)
+ CLOSE(KLUNAM)
+ RETURN
+ ELSE
+ INBLINE = 1
+ DO INBLINE=1, NUMBSTAT
+ READ(KLUNAM,FMT='(A400)') YSTRING
+ READ(YSTRING,*) TPSTATION%NAME(INBLINE), TPSTATION%TYPE(INBLINE),&
+ TPSTATION%LAT(INBLINE), TPSTATION%LON(INBLINE), TPSTATION%Z(INBLINE)!,&
+ END DO
+ REWIND(KLUNAM)
+ CLOSE(KLUNAM)
+ RETURN
+ END IF
+ END IF
+!
+END SUBROUTINE READ_CSV_STATION
+!#########################################################
+SUBROUTINE FRENCH_TO_ENGLISH(HSTRING)
+CHARACTER(LEN=400), INTENT(INOUT) :: HSTRING ! csv record
+INTEGER :: JL
+LOGICAL :: GFRENCH
+!
+GFRENCH = .FALSE.
+!* analyses if the record has been written in French convention
+! French convention (separator is ; decimal symbol is ,)
+! or English convention (separator is , decimal symbol is .)
+DO JL=1,400
+ IF (HSTRING(JL:JL)==';') GFRENCH=.TRUE.
+END DO
+!
+! If French convention is used in the file, transforms it in English convention
+IF (GFRENCH) THEN
+ DO JL=1,400
+ IF (HSTRING(JL:JL)==',') HSTRING(JL:JL)='.'
+ IF (HSTRING(JL:JL)==';') HSTRING(JL:JL)=','
+ END DO
+END IF
+!
+END SUBROUTINE FRENCH_TO_ENGLISH
+
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index d569258fe885d9eda14c752b56c487d0e792e57a..cc09425a87ef4a81be15d4d2edb65a21a5492ed8 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -364,6 +364,7 @@ USE MODD_LES
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_PARAM_LIMA
+USE MODD_TURB_n, ONLY: XCADAP
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -392,6 +393,9 @@ USE MODI_ETHETA
!
USE MODI_SECOND_MNH
!
+USE MODD_IBM_PARAM_n, ONLY : LIBM, XIBM_LS, XIBM_XMUT
+USE MODI_IBM_MIXINGLENGTH
+!
IMPLICIT NONE
!
!
@@ -469,6 +473,7 @@ REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coeff
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
! PRT(:,:,:,1) is the conservative mixing ratio
+!
! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
! TKE dissipation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
@@ -546,7 +551,6 @@ REAL :: ZL0 ! Max. Mixing Length in Blakadar formula
REAL :: ZALPHA ! work coefficient :
! - proportionnality constant between Dz/2 and
! ! BL89 mixing length near the surface
- ! - and coefficient to reduce DELT in ADAP
!
REAL :: ZTIME1, ZTIME2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH,ZCOR
@@ -779,8 +783,7 @@ SELECT CASE (HTURBLEN)
! For LES grid meshes, this is equivalent to Deardorff : the base mixing lentgh is the horizontal grid mesh,
! and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well)
! For grid meshes in the grey zone, then this is the smaller of the two.
- ZALPHA=0.50
- PLEM = MIN(PLEM,ZALPHA*ZLMW)
+ PLEM = MIN(PLEM,XCADAP*ZLMW)
!
!* 3.4 Delta mixing length
! -------------------
@@ -844,12 +847,22 @@ IF (ORMC01) THEN
CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,PLEM,ZLEPS)
END IF
!
+!RMC01 is only applied on RM17 in ADAP
+IF (HTURBLEN=='ADAP') ZLEPS = MIN(ZLEPS,ZLMW*XCADAP)
+!
!* 3.8 Mixing length in external points (used if HTURBDIM="3DIM")
! ----------------------------------------------------------
!
IF (HTURBDIM=="3DIM") THEN
CALL UPDATE_LM(HLBCX,HLBCY,PLEM,ZLEPS)
END IF
+!
+!* 3.9 Mixing length correction if immersed walls
+! ------------------------------------------
+!
+IF (LIBM) THEN
+ CALL IBM_MIXINGLENGTH(PLEM,ZLEPS,XIBM_XMUT,XIBM_LS(:,:,:,1),PTKET)
+ENDIF
!----------------------------------------------------------------------------
!
!* 4. GO INTO THE AXES FOLLOWING THE SURFACE
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index 711824444a53790ce8fd53934b8edf633a011d16..586327fad22fb00d877159e4e671f5c33b20a7d2 100644
--- a/src/MNH/viscosity.f90
+++ b/src/MNH/viscosity.f90
@@ -92,6 +92,7 @@ SUBROUTINE VISCOSITY(HLBCX, HLBCY, KRR, KSV, PNU, PPRANDTL, &
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 08/11/2019: corrected wrong budget name VISC_BU_RU -> VISC_BU_RTH
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! 02/21 (T.Nagel) Add adhesion condition in case of an IBM-obstacle at the domain top boundary
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -261,6 +262,8 @@ IF (OVISC_UVW) THEN
ZY1 = MXF(PUT)
IF (ODRAG) THEN
ZY1(:,:,1) = PDRAG * ZY1(:,:,2)
+!!Add adhesion condition in case of an IBM-obstacle at the domain top boundary
+! ZY1(:,:,IKU) = PDRAG * ZY1(:,:,IKE)
ENDIF
!
!
diff --git a/src/MNH/write_desfmn.f90 b/src/MNH/write_desfmn.f90
index c01d74a29d2327fdbba21ef72936691caef8a8cf..fb24c9bae47e3b7140e3a266768cffe9a5216841 100644
--- a/src/MNH/write_desfmn.f90
+++ b/src/MNH/write_desfmn.f90
@@ -144,6 +144,8 @@ END MODULE MODI_WRITE_DESFM_n
!! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification V. Vionnet 07/2017 add blowing snow variables
+!! Modification F.Auguste 02/2021 add IBM
+!! E.Jezequel 02/2021 add stations read from CSV file
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -201,6 +203,10 @@ USE MODD_FOREFIRE_n, ONLY : FFCOUPLING
#endif
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
+USE MODN_IBM_PARAM_n
+USE MODN_RECYCL_PARAM_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
+USE MODN_STATION_n
!
IMPLICIT NONE
!
@@ -307,6 +313,20 @@ ELSE !return to namelist meaning of LHORELAX_SV
END IF
WRITE(UNIT=ILUSEG,NML=NAM_DYNn)
!
+IF (LIBM_LSF) THEN
+ !
+ CALL INIT_NAM_IBM_PARAMn
+ !
+ WRITE(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+ !
+ IF (CPROGRAM/='MESONH') THEN
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ END IF
+ !
+END IF
+!
CALL INIT_NAM_ADVn
WRITE(UNIT=ILUSEG,NML=NAM_ADVn)
IF (CPROGRAM/='MESONH') THEN
@@ -369,6 +389,9 @@ CALL INIT_NAM_BLOWSNOWn
IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
!
+CALL INIT_NAM_STATIONn
+IF(LSTATION) WRITE(UNIT=ILUSEG,NML=NAM_STATIONn)
+!
IF(LDUST) WRITE(UNIT=ILUSEG,NML=NAM_DUST)
IF(LSALT) WRITE(UNIT=ILUSEG,NML=NAM_SALT)
IF(LPASPOL) WRITE(UNIT=ILUSEG,NML=NAM_PASPOL)
@@ -449,7 +472,17 @@ IF (NVERB >= 5) THEN
!
WRITE(UNIT=ILUOUT,FMT="('********** ADVECTIONn **************')")
WRITE(UNIT=ILUOUT,NML=NAM_ADVn)
-!
+ !
+ IF (LIBM_LSF) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+ ENDIF
+ !
+ IF (LRECYCL) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYCL_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
+ ENDIF
+ !
WRITE(UNIT=ILUOUT,FMT="('********** PARAMETERIZATIONSn ******')")
WRITE(UNIT=ILUOUT,NML=NAM_PARAMn)
!
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index c6a48c561cfa99011aa6f6995cca0a6a73f2f6ce..ee394f919dee89150d40158838f3e4f19adee935 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -174,6 +174,8 @@ END MODULE MODI_WRITE_LFIFM_n
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Tulet 02/2020: correction for dust and sea salts
! PA. Joulin 12/2020: add wind turbine outputs
+! F.Auguste 02/2021 : Add IBM
+! T.Nagel 02/2021 : Add turbulence recycling
! P. Wautelet 10/03/2021: use scalar variable names for dust and salt
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
!-------------------------------------------------------------------------------
@@ -184,7 +186,7 @@ END MODULE MODI_WRITE_LFIFM_n
USE MODD_DIM_n
USE MODD_CONF
USE MODD_CONF_n
-use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEINT, TYPEREAL
+use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEINT, TYPEREAL, TYPELOG
USE MODD_GRID
USE MODD_GRID_n
USE MODD_TIME
@@ -283,6 +285,10 @@ USE MODD_EOL_SHARED_IO
USE MODD_EOL_ADNR
USE MODD_EOL_ALM
!
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n, ONLY : LIBM,XIBM_LS
+USE MODD_IBM_LSF, ONLY : LIBM_LSF
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -434,6 +440,17 @@ CALL IO_Field_write(TPFILE,'SURF', CSURF)
CALL IO_Field_write(TPFILE,'CPL_AROME',LCPL_AROME)
CALL IO_Field_write(TPFILE,'COUPLING', LCOUPLING)
!
+TZFIELD%CMNHNAME = 'RECYCLING'
+TZFIELD%CLONGNAME = 'RECYCLING'
+TZFIELD%CSTDNAME = ''
+TZFIELD%CUNITS = ''
+TZFIELD%CDIR = ''
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPELOG
+TZFIELD%NDIMS = 0
+TZFIELD%LTIMEDEP = .FALSE.
+CALL IO_Field_write(TPFILE,TZFIELD,LRECYCL)
+!
!* 1.4 Prognostic variables :
!
!
@@ -467,6 +484,201 @@ IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
CALL IO_Field_write(TPFILE,'DWM',XDWM)
END IF
!
+IF (LIBM .OR. LIBM_LSF) THEN
+ !
+ TZFIELD%CMNHNAME = 'LSFP'
+ TZFIELD%CLONGNAME = 'LSFP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'Level Set Function at mass node'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XIBM_LS(:,:,:,1))
+ !
+ENDIF
+!
+IF (LRECYCL) THEN
+ !
+ TZFIELD%CMNHNAME = 'RCOUNT'
+ TZFIELD%CLONGNAME = 'RCOUNT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEINT
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'Incremental counter for averaging purpose'
+ CALL IO_Field_write(TPFILE,TZFIELD,R_COUNT)
+ !
+ IF (LRECYCLW) THEN
+ TZFIELD%CMNHNAME = 'URECYCLW'
+ TZFIELD%CLONGNAME = 'URECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANW(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLW'
+ TZFIELD%CLONGNAME = 'VRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANW(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLW'
+ TZFIELD%CLONGNAME = 'WRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANW(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLN) THEN
+ TZFIELD%CMNHNAME = 'URECYCLN'
+ TZFIELD%CLONGNAME = 'URECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANN(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLN'
+ TZFIELD%CLONGNAME = 'VRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANN(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLN'
+ TZFIELD%CLONGNAME = 'WRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANN(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLE) THEN
+ TZFIELD%CMNHNAME = 'URECYCLE'
+ TZFIELD%CLONGNAME = 'URECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANE(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLE'
+ TZFIELD%CLONGNAME = 'VRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANE(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLE'
+ TZFIELD%CLONGNAME = 'WRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'YY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANE(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLS) THEN
+ TZFIELD%CMNHNAME = 'URECYCLS'
+ TZFIELD%CLONGNAME = 'URECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-SOUTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANS(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLS'
+ TZFIELD%CLONGNAME = 'VRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-SOUTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANS(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLS'
+ TZFIELD%CLONGNAME = 'WRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm.s-1'
+ TZFIELD%CDIR = 'XX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-SOUTH side plan for recycling purpose'
+ !
+ ENDIF
+ENDIF
+!
IF (MEAN_COUNT /= 0) THEN
!
TZFIELD%CSTDNAME = ''
@@ -497,6 +709,13 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CCOMMENT = 'X_Y_Z_U component of max wind'
CALL IO_Field_write(TPFILE,TZFIELD,XUM_MAX)
!
+ TZFIELD%CMNHNAME = 'UWME'
+ TZFIELD%CLONGNAME = 'UWME'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CCOMMENT = 'X_Y_Z_UW component of mean wind variance'
+ ZWORK3D = XUW_MEAN/MEAN_COUNT-(XUM_MEAN*XWM_MEAN)/MEAN_COUNT**2
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
+ !
TZFIELD%NGRID = 3
!
TZFIELD%CMNHNAME = 'VMME'
@@ -542,6 +761,13 @@ IF (MEAN_COUNT /= 0) THEN
CALL IO_Field_write(TPFILE,TZFIELD,XWM_MAX)
!
TZFIELD%NGRID = 1
+!
+ TZFIELD%CMNHNAME = 'CMME'
+ TZFIELD%CLONGNAME = 'CMME'
+ TZFIELD%CUNITS = 'Kg Kg-1'
+ TZFIELD%CCOMMENT = 'mean Passive scalar'
+ ZWORK3D = XSVT_MEAN/MEAN_COUNT
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'THMME'
TZFIELD%CLONGNAME = 'THMME'
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index ecacfb93518111d04e6787461c881bb4f14c4648..441ba8068ff37f15ca8521475b52466a7c35c84f 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -81,7 +81,7 @@ USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT
USE MODD_NSV
USE MODD_PARAMETERS
-USE MODD_PARAM_n, ONLY: CRAD
+USE MODD_PARAM_n, ONLY: CRAD,CSURF
USE MODD_PASPOL
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_SALT, ONLY: CSALTNAMES, LSALT, NMODE_SLT
@@ -136,6 +136,7 @@ REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZW6 ! contains temporal series t
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZPTOTA
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX, ZTRAJY, ZTRAJZ
!
INTEGER, DIMENSION(:), ALLOCATABLE :: IGRID ! grid indicator
CHARACTER(LEN= 8) :: YGROUP ! group title
@@ -156,15 +157,19 @@ type(tfield_metadata_base), dimension(:), allocatable :: tzfields
IF (TSTATION%X(II)==XUNDEF) RETURN
IF (TSTATION%Y(II)==XUNDEF) RETURN
!
-IPROC = 8 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+IPROC = 6 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+IF (TSTATION%X(II)==XUNDEF) IPROC = IPROC + 2
IF (SIZE(TSTATION%TKE )>0) IPROC = IPROC + 1
-IF (LDIAG_IN_RUN) IPROC = IPROC + 17
+IF (LDIAG_IN_RUN) THEN
+ IF(CSURF=="EXTE") IPROC = IPROC + 10
+ IF(CRAD/="NONE") IPROC = IPROC + 7
+END IF
IF (LORILAM) IPROC = IPROC + JPMODE*(3+NSOA+NCARB+NSP)
IF (LDUST) IPROC = IPROC + NMODE_DST*3
IF (LSALT) IPROC = IPROC + NMODE_SLT*3
-IF (SIZE(TSTATION%TSRAD)>0) IPROC = IPROC + 1
-IF (SIZE(TSTATION%SFCO2,1)>0) IPROC = IPROC +1
+IF (ANY(TSTATION%TSRAD(:,:)/=XUNDEF)) IPROC = IPROC + 1
+IF (ANY(TSTATION%SFCO2(:,:)/=XUNDEF)) IPROC = IPROC + 1
!
ALLOCATE (ZWORK6(1,1,1,SIZE(tstation%tpdates),1,IPROC))
ALLOCATE (YCOMMENT(IPROC))
@@ -176,6 +181,13 @@ IGRID = 1
YGROUP = TSTATION%NAME(II)
JPROC = 0
!
+ALLOCATE (ZTRAJX(1,1,1))
+ALLOCATE (ZTRAJY(1,1,1))
+ALLOCATE (ZTRAJZ(1,1,1))
+!
+ZTRAJX(:,:,:)=TSTATION%X(II)
+ZTRAJY(:,:,:)=TSTATION%Y(II)
+ZTRAJZ(:,:,:)=TSTATION%Z(II)
!----------------------------------------------------------------------------
!
JPROC = JPROC + 1
@@ -190,17 +202,11 @@ YUNIT (JPROC) = 'Pascal'
YCOMMENT (JPROC) = 'Pressure'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%P(:,II)
!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LON'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Longitude'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LON(II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LAT'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Latitude'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LAT(II)
+!JPROC = JPROC + 1
+!YTITLE (JPROC) = 'Z'
+!YUNIT (JPROC) = 'm'
+!YCOMMENT (JPROC) = 'Z Pos'
+!ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Z(II)
!
IF (LCARTESIAN) THEN
JPROC = JPROC + 1
@@ -214,21 +220,45 @@ IF (LCARTESIAN) THEN
YUNIT (JPROC) = 'm'
YCOMMENT (JPROC) = 'Y Pos'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Y(II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'U'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Axial velocity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'V'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Transversal velocity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
+ELSE
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LON'
+ YUNIT (JPROC) = 'degree'
+ YCOMMENT (JPROC) = 'Longitude'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LON(II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LAT'
+ YUNIT (JPROC) = 'degree'
+ YCOMMENT (JPROC) = 'Latitude'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LAT(II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'ZON_WIND'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Zonal wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'MER_WIND'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Meridional wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
ENDIF
!
JPROC = JPROC + 1
-YTITLE (JPROC) = 'ZON_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Zonal wind'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'MER_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Meridional wind'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
-!
-JPROC = JPROC + 1
YTITLE (JPROC) = 'W'
YUNIT (JPROC) = 'm s-1'
YCOMMENT (JPROC) = 'Air vertical speed'
@@ -241,60 +271,67 @@ YCOMMENT (JPROC) = 'Potential temperature'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TH(:,II)
!
IF (LDIAG_IN_RUN) THEN
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'T2m'
- YUNIT (JPROC) = 'K'
- YCOMMENT (JPROC) = '2-m temperature'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%T2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'Q2m'
- YUNIT (JPROC) = 'kg kg-1'
- YCOMMENT (JPROC) = '2-m humidity'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Q2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'HU2m'
- YUNIT (JPROC) = 'percent'
- YCOMMENT (JPROC) = '2-m relative humidity'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%HU2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'zon10m'
- YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m zonal wind'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON10M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'mer10m'
- YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m meridian wind'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER10M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'RN'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Net radiation'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%RN(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'H'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Sensible heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%H(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LE'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Total Latent heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LE(:,II)
-!
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'G'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Storage heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%GFLUX(:,II)
- !
+ IF (CSURF=="EXTE") THEN
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'T2m'
+ YUNIT (JPROC) = 'K'
+ YCOMMENT (JPROC) = '2-m temperature'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%T2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'Q2m'
+ YUNIT (JPROC) = 'kg kg-1'
+ YCOMMENT (JPROC) = '2-m humidity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Q2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'HU2m'
+ YUNIT (JPROC) = 'percent'
+ YCOMMENT (JPROC) = '2-m relative humidity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%HU2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'zon10m'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = '10-m zonal wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON10M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'mer10m'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = '10-m meridian wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER10M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'RN'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Net radiation'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%RN(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'H'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Sensible heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%H(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LE'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Total Latent heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LE(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'G'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Storage heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%GFLUX(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LEI'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Solid Latent heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LEI(:,II)
+ END IF
IF (CRAD /= 'NONE') THEN
JPROC = JPROC + 1
YTITLE (JPROC) = 'SWD'
@@ -339,11 +376,6 @@ IF (LDIAG_IN_RUN) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%DSTAOD(:,II)
!
END IF
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LEI'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Solid Latent heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LEI(:,II)
ENDIF
!
DO JRR=1,SIZE(TSTATION%R,3)
@@ -695,7 +727,7 @@ ENDIF
DEALLOCATE (ZN0,ZRG,ZSIG)
END IF
-IF (SIZE(TSTATION%TSRAD,1)>0) THEN
+IF (ANY(TSTATION%TSRAD(:,:)/=XUNDEF)) THEN
JPROC = JPROC+1
YTITLE (JPROC) = 'Tsrad'
YUNIT (JPROC) = 'K'
@@ -703,7 +735,7 @@ IF (SIZE(TSTATION%TSRAD,1)>0) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TSRAD(:,II)
END IF
!
-IF (SIZE(TSTATION%SFCO2,1)>0) THEN
+IF (ANY(TSTATION%SFCO2(:,:)/=XUNDEF)) THEN
JPROC = JPROC+1
YTITLE (JPROC) = 'SFCO2'
YUNIT (JPROC) = 'mg m-2 s-1'
@@ -753,6 +785,7 @@ tzbudiachro%nkl = 1
tzbudiachro%nkh = 1
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tstation%tpdates, zw6 )
+! TODO: ajout de PTRAJX=ZTRAJX, PTRAJY=ZTRAJY, PTRAJZ=ZTRAJZ en argument en entrée de Write_diachro
deallocate( tzfields )