!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_IBM_GENERLS ! ####################### ! INTERFACE ! SUBROUTINE IBM_GENERLS(PIBM_XYZ,PPHI) ! REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! !------------------------------------------------------------------------------ ! END SUBROUTINE IBM_GENERLS ! END INTERFACE ! END MODULE MODI_IBM_GENERLS ! ! ##################################### SUBROUTINE IBM_GENERLS(PIBM_XYZ,PPHI) ! ##################################### ! !! !!**** IBM_GENERLS computes LS using any generalized surface !! !! PURPOSE !! ------- !!**** The purpose of this routine is to estimate the level set !! containing XYZ minimalisationinterface locations ! !! METHOD !! ------ !!**** Iterative system and minimization of the interface distance !! !! EXTERNAL !! -------- !! SUBROUTINE ? !! !! IMPLICIT ARGUMENTS !! ------------------ !! MODD_? !! !! REFERENCE !! --------- !! !! AUTHOR !! ------ !! Franck Auguste (CERFACS-AE) !! !! MODIFICATIONS !! ------------- !! Original 01/01/2015 !! !------------------------------------------------------------------------------ ! !**** 0. DECLARATIONS ! --------------- ! ! module USE MODE_POS USE MODE_ll USE MODE_IO_ll ! ! declaration USE MODD_IBM_PARAM_n USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ ! ! interface USE MODI_SHUMAN USE MODI_IBM_INTERPOS ! IMPLICIT NONE ! ! 0.1 declarations of arguments ! REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ ! interface location REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions ! !------------------------------------------------------------------------------ ! ! 0.2 declaration of local variables ! INTEGER :: JI,JJ,JK,JN,JM,JN2,JN4 ! loop index INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX, & ! loop boundaries IIU,IJU,IKU REAL :: Z_DIST_TEST1,Z_DIST_TEST2 ! saving distances REAL :: Z_DIST_TEST3,Z_DIST_TEST4,ZDIST_REF0 INTEGER :: INUMB_SURF ! saving points number INTEGER :: INUMB_SAVE ! saving point REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM CHARACTER(LEN=1) :: YPOS REAL :: ZRXCEN,ZRYCEN,ZRZCEN,ZRLREF, ZRLNUM REAL :: Z_DIST_TEST5,PRODS1,PRODS2 INTEGER :: JN5 ! !------------------------------------------------------------------------------ ! ! 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)) ! !------------------------------------------------------------------------------- ! !**** 1. PRELIMINARIES ! ---------------- ! Z_DIST_TEST1 = XIBM_IEPS Z_DIST_TEST3 = XIBM_IEPS INUMB_SURF = SIZE(PIBM_XYZ,1) ! !------------------------------------------------------------------------------- ! !**** 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) ! DO JK = JK_MIN,JK_MAX DO JJ = JJ_MIN,JJ_MAX DO JI = JI_MIN,JI_MAX Z_DIST_TEST2 = XIBM_IEPS Z_DIST_TEST4 = XIBM_IEPS Z_DIST_TEST5 = XIBM_EPSI INUMB_SAVE = 0 DO JN = 1,INUMB_SURF Z_DIST_TEST1 = sqrt((ZXHATM(JI,JJ,JK)-PIBM_XYZ(JN,1))**2.0 + & (ZYHATM(JI,JJ,JK)-PIBM_XYZ(JN,2))**2.0 + & (ZZHATM(JI,JJ,JK)-PIBM_XYZ(JN,3))**2.0) Z_DIST_TEST3 = sqrt((ZXHATM(JI,JJ,JK)-PIBM_XYZ(JN,1))**2.0 + & (ZYHATM(JI,JJ,JK)-PIBM_XYZ(JN,2))**2.0) IF (Z_DIST_TEST2 .gt. Z_DIST_TEST1) THEN JN2 = JN Z_DIST_TEST2 = Z_DIST_TEST1 ENDIF IF (Z_DIST_TEST4 .gt. Z_DIST_TEST3) THEN JN4 = JN Z_DIST_TEST4 = Z_DIST_TEST3 ENDIF IF (Z_DIST_TEST5 .lt. Z_DIST_TEST1) THEN Z_DIST_TEST5 = Z_DIST_TEST1 JN5 = JN ENDIF ENDDO ! ! INIT FOR A GENERALIZED SURFACE IF (ZZHATM(JI,JJ,JK) .lt. PIBM_XYZ(JN4,3)) then ZDIST_REF0 = +Z_DIST_TEST2 ELSE ZDIST_REF0 = -Z_DIST_TEST2 ENDIF ! ! INIT FOR CYLINDER ! ZRXCEN = 500. ! ZRYCEN = 500. ! ZRZCEN = 500. ! ZRLREF = 250. ! ZRLNUM = ((ZXHATM(JI,JJ,JK)-ZRXCEN)**2.+(ZZHATM(JI,JJ,JK)-ZRZCEN)**2.)**0.5 ! IF (ZRLNUM .gt. ZRLREF) THEN ! ZDIST_REF0 = +Z_DIST_TEST2 ! ELSE ! ZDIST_REF0 = -Z_DIST_TEST2 ! ENDIF ! ! INIT FOR CUBE ! PRODS1 = (ZXHATM(JI,JJ,JK)-PIBM_XYZ(JN2,1))*(ZXHATM(JI,JJ,JK)-PIBM_XYZ(JN5,1))+& ! (ZYHATM(JI,JJ,JK)-PIBM_XYZ(JN2,2))*(ZYHATM(JI,JJ,JK)-PIBM_XYZ(JN5,2))+& ! (ZZHATM(JI,JJ,JK)-PIBM_XYZ(JN2,3))*(ZZHATM(JI,JJ,JK)-PIBM_XYZ(JN5,3)) ! IF (PRODS1 .lt. -XIBM_EPSI) THEN ! ZDIST_REF0 = +Z_DIST_TEST2 ! ELSE ! ZDIST_REF0 = -Z_DIST_TEST2 ! ENDIF ! IF (ZDIST_REF0 .gt. +XIBM_EPSI) THEN ! IF (PPHI(JI,JJ,JK,JM) .lt. XIBM_EPSI ) PPHI(JI,JJ,JK,JM) = ZDIST_REF0 ! IF (PPHI(JI,JJ,JK,JM) .gt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0 ! ENDIF ! IF (ZDIST_REF0 .lt. -XIBM_EPSI) THEN IF (PPHI(JI,JJ,JK,JM) .lt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0 ! ENDIF ! IF (abs(ZDIST_REF0) .lt. abs(XIBM_EPSI)) PPHI(JI,JJ,JK,JM) = 0. ENDDO ENDDO ENDDO ENDDO ! !------------------------------------------------------------------------------- ! !**** X. DEALLOCATIONS/CLOSES ! ----------------------- ! DEALLOCATE(ZXHATM,ZYHATM,ZZHATM) ! RETURN ! END SUBROUTINE IBM_GENERLS