Skip to content
Snippets Groups Projects
Commit 9ab6e5fa authored by RODIER Quentin's avatar RODIER Quentin
Browse files

Quentin 16/08/2022: bugfix compilation: 

- Mesonh: add ext/ibm_affectv and remove USE MODI_IBM_MIXINGLENGTH (not used)
- AROME : mnh_expand in tm06 optimization and simplify ibm_mixinglength
parent 912b63aa
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/arome/turb/mode_ibm_mixinglength.F90 0 → 100644
+ 67
− 0
View file @ 9ab6e5fa
!MNH_LIC Copyright 2019-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 MODE_IBM_MIXINGLENGTH
IMPLICIT NONE
CONTAINS
SUBROUTINE IBM_MIXINGLENGTH(D,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 MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
!
!------------------------------------------------------------------------------
!
! 0.1 Declaration of arguments
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PLM
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PLEPS
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PMU
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PHI
REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZALPHA,ZBETA
REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZLM,ZMU,ZLN
!
! IBM CAN NOT BE USED WITH AROME
!
END SUBROUTINE IBM_MIXINGLENGTH
END MODULE MODE_IBM_MIXINGLENGTH
src/common/turb/mode_tm06.F90
+ 10
− 5
View file @ 9ab6e5fa
...@@ -72,7 +72,7 @@ REAL, DIMENSION(D%NIJT,D%NKT):: ZZ_O_H ! normalized height z/h (where h=BL heigh ...@@ -72,7 +72,7 @@ REAL, DIMENSION(D%NIJT,D%NKT):: ZZ_O_H ! normalized height z/h (where h=BL heigh
REAL, DIMENSION(D%NIJT) :: ZWSTAR ! normalized convective velocity w* REAL, DIMENSION(D%NIJT) :: ZWSTAR ! normalized convective velocity w*
REAL, DIMENSION(D%NIJT) :: ZTSTAR ! normalized temperature velocity w* REAL, DIMENSION(D%NIJT) :: ZTSTAR ! normalized temperature velocity w*
! !
INTEGER :: JK ! loop counter INTEGER :: JK,JIJ ! loop counter
INTEGER :: IIJE,IIJB INTEGER :: IIJE,IIJB
INTEGER :: IKTB,IKTE,IKB,IKE,IKT ! vertical levels INTEGER :: IKTB,IKTE,IKB,IKE,IKT ! vertical levels
!---------------------------------------------------------------------------- !----------------------------------------------------------------------------
...@@ -103,9 +103,9 @@ END WHERE ...@@ -103,9 +103,9 @@ END WHERE
! !
!* normalized height !* normalized height
! !
!$mnh_expand_array(JIJ=IIJB:IIJE) !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT)
ZZ_O_H(IIJB:IIJE,1:D%NKT) = XUNDEF ZZ_O_H(IIJB:IIJE,1:D%NKT) = XUNDEF
!$mnh_end_expand_array(JIJ=IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT)
DO JK=1,IKT DO JK=1,IKT
!$mnh_expand_where(JIJ=IIJB:IIJE) !$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE (PBL_DEPTH(IIJB:IIJE)/=XUNDEF) WHERE (PBL_DEPTH(IIJB:IIJE)/=XUNDEF)
...@@ -122,10 +122,12 @@ WHERE(ZZ_O_H(IIJB:IIJE,1:D%NKT) < 0.95 .AND. ZZ_O_H(IIJB:IIJE,1:D%NKT)/=XUNDEF) ...@@ -122,10 +122,12 @@ WHERE(ZZ_O_H(IIJB:IIJE,1:D%NKT) < 0.95 .AND. ZZ_O_H(IIJB:IIJE,1:D%NKT)/=XUNDEF)
PMTH2(IIJB:IIJE,1:D%NKT) = 4.*(MAX(ZZ_O_H(IIJB:IIJE,1:D%NKT),0.))**0.4*(ZZ_O_H(IIJB:IIJE,1:D%NKT)-0.95)**2 PMTH2(IIJB:IIJE,1:D%NKT) = 4.*(MAX(ZZ_O_H(IIJB:IIJE,1:D%NKT),0.))**0.4*(ZZ_O_H(IIJB:IIJE,1:D%NKT)-0.95)**2
END WHERE END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
!$mnh_expand_array(JIJ=IIJB:IIJE)
DO JK=IKTB+1,IKTE-1 DO JK=IKTB+1,IKTE-1
!$mnh_expand_array(JIJ=IIJB:IIJE)
PMTH2(IIJB:IIJE,JK) = PMTH2(IIJB:IIJE,JK) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE) PMTH2(IIJB:IIJE,JK) = PMTH2(IIJB:IIJE,JK) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO END DO
!$mnh_expand_array(JIJ=IIJB:IIJE)
PMTH2(IIJB:IIJE,IKE)=PMTH2(IIJB:IIJE,IKE) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE) PMTH2(IIJB:IIJE,IKE)=PMTH2(IIJB:IIJE,IKE) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE)
PMTH2(IIJB:IIJE,D%NKU)=PMTH2(IIJB:IIJE,D%NKU) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE) PMTH2(IIJB:IIJE,D%NKU)=PMTH2(IIJB:IIJE,D%NKU) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE)
...@@ -140,10 +142,13 @@ WHERE(ZZ_O_H(IIJB:IIJE,1:D%NKT) <0.9 .AND. ZZ_O_H(IIJB:IIJE,1:D%NKT)/=XUNDEF) ...@@ -140,10 +142,13 @@ WHERE(ZZ_O_H(IIJB:IIJE,1:D%NKT) <0.9 .AND. ZZ_O_H(IIJB:IIJE,1:D%NKT)/=XUNDEF)
* (ABS(ZZ_O_H(IIJB:IIJE,1:D%NKT)-1.))**0.58 + 0.37, 0.) * (ABS(ZZ_O_H(IIJB:IIJE,1:D%NKT)-1.))**0.58 + 0.37, 0.)
END WHERE END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
!$mnh_expand_array(JIJ=IIJB:IIJE)
DO JK=IKTB+1,IKTE-1 DO JK=IKTB+1,IKTE-1
!$mnh_expand_array(JIJ=IIJB:IIJE)
PMWTH(IIJB:IIJE,JK) = PMWTH(IIJB:IIJE,JK) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE) PMWTH(IIJB:IIJE,JK) = PMWTH(IIJB:IIJE,JK) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
END DO END DO
!$mnh_expand_array(JIJ=IIJB:IIJE)
PMWTH(IIJB:IIJE,IKE) = PMWTH(IIJB:IIJE,IKE) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE) PMWTH(IIJB:IIJE,IKE) = PMWTH(IIJB:IIJE,IKE) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE)
PMWTH(IIJB:IIJE,D%NKU) = PMWTH(IIJB:IIJE,D%NKU) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE) PMWTH(IIJB:IIJE,D%NKU) = PMWTH(IIJB:IIJE,D%NKU) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE)
!$mnh_end_expand_array(JIJ=IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE)
......
src/mesonh/ext/ibm_affectv.f90 0 → 100644
+ 402
− 0
View file @ 9ab6e5fa
!MNH_LIC Copyright 2019-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 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_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
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

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