!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_PREP ! #################### ! INTERFACE ! SUBROUTINE IBM_PREP(OIBM,HIBM_TYPE,PPHI) ! LOGICAL ,INTENT(IN) :: OIBM CHARACTER(LEN=4) ,INTENT(IN) :: HIBM_TYPE REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! !------------------------------------------------------------------------------ ! END SUBROUTINE IBM_PREP ! END INTERFACE ! END MODULE MODI_IBM_PREP ! ! ######################################## SUBROUTINE IBM_PREP(OIBM,HIBM_TYPE,PPHI) ! ######################################## ! !! !!**** IBM_PREP 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 !! - Type of surface !! - LS computation !! !! 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 USE MODD_VAR_ll, ONLY: IP ! ! 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,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_GENERLS 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 ! loop index INTEGER :: ILUIBMIDEAL,IRESPIBMGENER,ILUIBMGENER,IRESPIBMIDEAL ! 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) IIBM_TYPE_SURF, & ! type of surfaces 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 :: XXX,YYY,ZZZ INTEGER :: JI,JJ,JK ! INTEGER :: IRESPIBMREAL,ILUIBMREAL REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZSURF,ZINDI,ZTMP2,ZTMP3 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP,ZPHI REAL :: ZLAT,ZLON,ZHEI,ZIBM_HEI INTEGER :: KNUM,KBOR,KIBM_BATMIN,KIBM_BATMAX INTEGER :: IIU,IJU,IKU,KII,KJJ INTEGER :: JI2,JJ2,JK2,JI3,JJ3,JK3 CHARACTER(LEN=10) :: YHCOUNT1 CHARACTER(LEN=24) :: YHCOUNT2 LOGICAL :: GHCOUNT3 REAL :: ZXX,ZYY,ZXM2,ZYM2,ZII,ZJJ REAL :: ZMAX1,ZMAX2,ZMAX3 REAL :: IIMAX,IJMAX,IKMAX REAL :: ZXX1,ZYY1,ZZZ1,ZXX2,ZYY2,ZZZ2 INTEGER :: JIM1,JIP1,JIM2,JIP2,JIM4,JIP4 INTEGER :: JJM1,JJP1,JJM2,JJP2,JJM4,JJP4 REAL :: ZTES1,ZTES2,ZTES3,ZTES4,ZDIS,ZHIGH,ZHORI TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll 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 REAL :: ZLATMIN,ZLATMAX,ZLONMIN,ZLONMAX,ZXM2MIN,ZXM2MAX, ZYM2MIN, ZYM2MAX REAL :: SIGN1,SIGN2,SIGN3,SIGN4,ZHEI2 REAL :: ZX1,ZY1,ZX2,ZY2,ZIND ! !------------------------------------------------------------------------------ ! ! 0.3 Allocation ! !------------------------------------------------------------------------------ ! !* *** 1. PRELIMINARIES ! ---------------- ! ! Read input files in order to compute interface location ! - 'ibm_gener.nam' for generalized case ! (first line is the number of surface nodes IIBM_NUMB_NODE_SURF, ! others lines for surface nodes position (X,Y,Z)) ! - 'ibm_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) ! ! CALL OPEN_ll(UNIT=ILUIBMGENER , FILE='ibm_4800.nam', IOSTAT=IRESPIBMGENER , FORM='FORMATTED' , & ! STATUS='NEW', ACCESS='SEQUENTIAL', ACTION='WRITE', MODE = GLOBAL ) ! ! DO JI=1,1025 ! DO JJ=1,513 ! XXX = (JI*1.-1.)*50. ! YYY = (JJ*1.-1.)*50. ! ZZZ = 4800.*(1./(1.+((XXX-12800.)/1200.)**2.))*(1./(1.+((YYY-12800.)/1200.)**2.)) ! WRITE(UNIT=ILUIBMGENER,FMT=*) XXX,YYY,ZZZ ! ENDDO ! ENDDO ! ! CALL OPEN_ll(UNIT=ILUIBMGENER , FILE='ibm_2400.nam', IOSTAT=IRESPIBMGENER , FORM='FORMATTED' , & ! STATUS='NEW', ACCESS='SEQUENTIAL', ACTION='WRITE', MODE = GLOBAL ) ! ! DO JI=1,513 ! DO JJ=1,257 ! XXX = (JI*1.-1.)*100. ! YYY = (JJ*1.-1.)*100. ! ZZZ = 2400.*(1./(1.+((XXX-12800.)/1200.)**2.))!*(1./(1.+((YYY-12800.)/1200.)**2.)) ! WRITE(UNIT=ILUIBMGENER,FMT=*) XXX,YYY,ZZZ ! ENDDO ! ENDDO ! ! STOP IF ((HIBM_TYPE=='GENE').or.(HIBM_TYPE=='GEID')) THEN CALL OPEN_ll(UNIT=ILUIBMGENER , FILE='ibm_gene.nam', IOSTAT=IRESPIBMGENER , FORM='FORMATTED' , & STATUS='OLD', ACCESS='SEQUENTIAL', ACTION='READ', MODE = GLOBAL ) READ(UNIT=ILUIBMGENER,FMT=*) IIBM_NUMB_NODE_SURF ALLOCATE(ZIBM_XYZ1(IIBM_NUMB_NODE_SURF,3)) ZIBM_XYZ1(:,:) = 0. DO JN=1,IIBM_NUMB_NODE_SURF READ(UNIT=ILUIBMGENER,FMT=*) ZIBM_XYZ1(JN,1),ZIBM_XYZ1(JN,2),ZIBM_XYZ1(JN,3) ENDDO ENDIF IF ((HIBM_TYPE=='IDEA').or.(HIBM_TYPE=='GEID').or.(HIBM_TYPE=='IDRE')) THEN CALL OPEN_ll(UNIT=ILUIBMIDEAL , FILE='ibm_idea.nam', IOSTAT=IRESPIBMIDEAL , FORM='FORMATTED' , & STATUS='OLD', ACCESS='SEQUENTIAL', ACTION='READ', MODE = GLOBAL ) READ(UNIT=ILUIBMIDEAL,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=ILUIBMIDEAL,FMT=*) IIBM_TYPE_SURF, IIBM_NUMB_SURF ZIBM_TYPE_SURF= float(IIBM_TYPE_SURF) DO JM=1,IIBM_NUMB_SURF READ(UNIT=ILUIBMIDEAL,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 ! generalized shape => construction of LS function (z phi>0) ! with an iterative system based on all surface nodes ! => conversion of LS function to VF function (Sussman, JCP (1994) ! idealized shape => construction of VF/LS function using analytical ! locations of interface (ellipsoidal/parallelepipedic shapes) ! IF ((HIBM_TYPE=='GENE').or.(HIBM_TYPE=='GEID')) THEN ! CALL IBM_GENERLS(ZIBM_XYZ1,PPHI) ENDIF IF ((HIBM_TYPE=='IDEA').or.(HIBM_TYPE=='GEID').or.(HIBM_TYPE=='IDRE')) 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 IF (HIBM_TYPE=='IDRE') THEN ALLOCATE(ZPHI(SIZE(PPHI,1),SIZE(PPHI,2),SIZE(PPHI,3),SIZE(PPHI,4))) ZPHI(:,:,:,:)=PPHI(:,:,:,:) ENDIF ENDIF ! real case (B0) IF ((HIBM_TYPE=='REAL').or.(HIBM_TYPE=='IDRE')) THEN ! ! Computation of the Levelset function when the incoming signal is a discrete ! one (location of the roof building in lat/lon coordinates). Details in the ! AZF article (Appendix) is available ! ! Thickness spatial resolution IIBM_LEVEL = 3 IIBM_MIDDLE = 1 ZHIGH = 0040. ZHORI = 4000. CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) IIU=SIZE(PPHI,1) IJU=SIZE(PPHI,2) IKU=SIZE(PPHI,3) IKB = 1 + JPVEXT IKE = IKU - JPVEXT ZIBM_HEI=ABS(XZZ(IIB,IJB,IKB)-XZZ(IIB,IJB,IKB+1)) ZHEI2 = 3.5*ZIBM_HEI ZTES1 = (((XXHAT(IIB)-XXHAT(IIE)))**2.+((XYHAT(IJB)-XYHAT(IJE)))**2.)**0.5 ZTES2 = (XXHAT(IIB)+XXHAT(IIE))/2. ZTES3 = (XYHAT(IJB)+XYHAT(IJE))/2. ZTES4 = (((XXHAT(IIB)-XXHAT(IIB+1)))**2.)**0.5 ALLOCATE(ZSURF(IIU,IJU,4),ZINDI(IIU,IJU,4)) ALLOCATE(ZTMP(IIU,IJU,IKU,7)) ALLOCATE(ZTMP2(IIU,IJU,4),ZTMP3(IIU,IJU,4)) ZTMP(:,:,:,:) = -1. ZSURF(:,:,:) = 0. ZINDI(:,:,:) = 0. ZTMP2(:,:,:) = 0. ZTMP3(:,:,:) = 0. ! loop on ascii file (B1) KIBM_BATMIN=1 KIBM_BATMAX=2!2716 JMM = 0 DO JN = KIBM_BATMIN,KIBM_BATMAX,1 JMM = JMM+1 ! select format name (B2) IF (JN<=9) THEN WRITE(YHCOUNT1,'(I1)') JN YHCOUNT2 = 'BATI/batiment_000000000' // YHCOUNT1 ELSEIF ((JN>9).AND.(JN<=99)) THEN WRITE(YHCOUNT1,'(I2)') JN YHCOUNT2 = 'BATI/batiment_00000000' // YHCOUNT1 ELSEIF ((JN>99).AND.(JN<=999)) THEN WRITE(YHCOUNT1,'(I3)') JN YHCOUNT2 = 'BATI/batiment_0000000' // YHCOUNT1 ELSEIF ((JN>999).AND.(JN<=9999)) THEN WRITE(YHCOUNT1,'(I4)') JN YHCOUNT2 = 'BATI/batiment_000000' // YHCOUNT1 ELSEIF ((JN>9999).AND.(JN<=99999)) THEN WRITE(YHCOUNT1,'(I5)') JN YHCOUNT2 = 'BATI/batiment_00000' // YHCOUNT1 ELSEIF ((JN>99999).AND.(JN<=999999)) THEN WRITE(YHCOUNT1,'(I6)') JN YHCOUNT2 = 'BATI/batiment_0000' // YHCOUNT1 ELSEIF ((JN>999999).AND.(JN<=9999999)) THEN WRITE(YHCOUNT1,'(I7)') JN YHCOUNT2 = 'BATI/batiment_000' // YHCOUNT1 ELSEIF ((JN>9999999).AND.(JN<=99999999)) THEN WRITE(YHCOUNT1,'(I8)') JN YHCOUNT2 = 'BATI/batiment_00' // YHCOUNT1 ELSEIF ((JN>99999999).AND.(JN<=999999999)) THEN WRITE(YHCOUNT1,'(I9)') JN YHCOUNT2 = 'BATI/batiment_0' // YHCOUNT1 ELSE WRITE(YHCOUNT1,'(I10)')JN YHCOUNT2 = 'BATI/batiment_' // YHCOUNT1 ENDIF !(E2) ! file existence (B3) INQUIRE(FILE=trim(YHCOUNT2), exist=GHCOUNT3) IF (GHCOUNT3==.TRUE.) THEN CALL OPEN_ll(UNIT=ILUIBMREAL , FILE=YHCOUNT2, IOSTAT=IRESPIBMREAL , FORM='FORMATTED' , & STATUS='OLD', ACCESS='SEQUENTIAL', ACTION='READ', MODE = GLOBAL ) REWIND(UNIT=ILUIBMREAL) ! line existence (B4) DO WHILE (IRESPIBMREAL<=0) READ(UNIT=ILUIBMREAL,FMT=*,IOSTAT=IRESPIBMREAL,END=1000) ZLAT,ZLON,ZIND!ZHEI,KNUM,KBOR ! COVER 182/143/144/141 IF (ABS(ZIND-158.).GT.XIBM_EPSI) GO TO 112 IF (ABS(ZIND-158.).LT.XIBM_EPSI) ZHEI=26. IF (ZLAT.GT.49.92) GO TO 113 IF (ZLON.GT.-6.30) GO TO 114 ! height limitation (B5) IF ((ZHEI<1.*IIBM_LEVEL*ZIBM_HEI)) GO TO 111 IF ((ZHEI>(1.*IIBM_LEVEL*ZIBM_HEI-XIBM_EPSI)).AND.(ZHEI55.)) ZHEI=55. !(E5) ! convert latlon to xy (B6) CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZXM2,ZYM2) !(E6) ! horizontal limitation ! IF ((ZHORI+ZTES1).LT.((ZXM2-ZTES2)**2.+(ZYM2-ZTES3)**2.)**0.5) GO TO 111 ! loop on node type (B7) DO JM = 1,4 ! searching for the closest node (B8) IF (JM==1) THEN ZXX = ZXM2-(XXHAT(IIB)+XXHAT(IIB+1))/2. ZYY = ZYM2-(XYHAT(IJB)+XYHAT(IJB+1))/2. ENDIF IF (JM==2) THEN ZXX = ZXM2-(XXHAT(IIB)+XXHAT(IIB ))/2. ZYY = ZYM2-(XYHAT(IJB)+XYHAT(IJB+1))/2. ENDIF IF (JM==3) THEN ZXX = ZXM2-(XXHAT(IIB)+XXHAT(IIB+1))/2. ZYY = ZYM2-(XYHAT(IJB)+XYHAT(IJB ))/2. ENDIF IF (JM==4) THEN ZXX = ZXM2-(XXHAT(IIB)+XXHAT(IIB ))/2. ZYY = ZYM2-(XYHAT(IJB)+XYHAT(IJB ))/2. ENDIF ZII = ZXX/ZIBM_HEI ZJJ = ZYY/ZIBM_HEI IF (ZII>0.) THEN KII =+NINT(+ZII)+IIB ELSE KII =-NINT(-ZII)+IIB ENDIF IF (ZJJ>0.) THEN KJJ =+NINT(+ZJJ)+IJB ELSE KJJ =-NINT(-ZJJ)+IJB ENDIF IF ((KII>=1.AND.KII<=IIU).AND. & (KJJ>=1.AND.KJJ<=IJU)) THEN ZSURF(KII,KJJ,JM)=ZHEI+(JMM*1.-KIBM_BATMIN*1.)*XIBM_EPSI**0.5/(KIBM_BATMAX*1.+KIBM_BATMIN*1.) ENDIF ENDDO !(E7) 114 CONTINUE 113 CONTINUE 112 CONTINUE ENDDO !(E4) 1000 CONTINUE 111 CONTINUE CALL CLOSE_ll(YHCOUNT2,IOSTAT=IRESPIBMREAL) ENDIF !(E3) ENDDO !(E1) ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! index affectation CALL INDEX_UNIFRM0(ZTMP3,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL,ZHEI2) CALL INDEX_UNIFRM6(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL,ZHEI) CALL INDEX_UNIFRM1(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL,ZHEI2,ZTMP3) ! CALL INDEX_UNIFRM2(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) CALL INDEX_AFFECT (ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) DO JM=1,4!B1 IIMAX = IIE IJMAX = IJE IF (JM==2) IIMAX=IIMAX+1 IF (JM==3) IJMAX=IJMAX+1 IF (JM==4) IIMAX=IIMAX+1 IF (JM==4) IJMAX=IJMAX+1 DO KIBM_LEVEL=IIBM_LEVEL-1,1,-1!C1 SIGN1=(KIBM_LEVEL*1.-IIBM_MIDDLE*1.-XIBM_EPSI)/ABS(KIBM_LEVEL*1.-IIBM_MIDDLE*1.-XIBM_EPSI) SIGN1=MAX(0.,SIGN1) SIGN3=1.-SIGN1 DO KLOOP=-1,1,2!D1 ZTMP2(:,:,JM) = ZSURF(:,:,JM) SIGN2=MAX(0.,KLOOP*1.) SIGN4=1.-SIGN2 DO JI=IIB,IIMAX!E1 DO JJ=IJB,IJMAX!F1 IF ((ABS(ZINDI(JI,JJ,JM)-KIBM_LEVEL*1.*KLOOP*1.)).GT.XIBM_EPSI) GO TO 444 ZMAX3 = ZINDI(JI,JJ,JM) JIM1=MAX(JI-1,1) JJM1=MAX(JJ-1,1) JIP1=MIN(JI+1,IIU) JJP1=MIN(JJ+1,IJU) DO JI2=JIM1,JIP1!G1 DO JJ2=JJM1,JJP1!H1 ! ZMAX3=MAX(ZMAX3,ZINDI(JI2,JJ2,JM))*SIGN2+MIN(ZMAX3,ZINDI(JI2,JJ2,JM))*SIGN4 ZMAX3=MAX(ZMAX3,ZINDI(JI2,JJ2,JM)*KLOOP*1.) ENDDO!H2 ENDDO!G2 IF ((ABS(ZMAX3-KIBM_LEVEL*1.*KLOOP*1.)).LT.XIBM_EPSI) GO TO 444 ZMAX2 = ZSURF(JI,JJ,JM) JIM2=MAX(JI-(KIBM_LEVEL),1) JJM2=MAX(JJ-(KIBM_LEVEL),1) JIP2=MIN(JI+(KIBM_LEVEL),IIU) JJP2=MIN(JJ+(KIBM_LEVEL),IJU) DO JI2=JIM2,JIP2!G3 DO JJ2=JJM2,JJP2!H3 ZMAX2=MAX(ZMAX2,ZSURF(JI2,JJ2,JM)) ENDDO!H4 ENDDO!G4 DO JI2=JIM2,JIP2!G3 DO JJ2=JJM2,JJP2!H3 ZTMP2(JI2,JJ2,JM)=ZMAX2*(SIGN1*SIGN2+SIGN3*SIGN4) ENDDO!H4 ENDDO!G4 444 CONTINUE ENDDO!F2 ENDDO!E2 ZSURF(:,:,JM) = ZTMP2(:,:,JM) NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,JM)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) CALL INDEX_AFFECT(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) ENDDO!D2 ENDDO!C2 ENDDO!B2 CALL INDEX_UNIFRM1(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL,ZHEI2,ZTMP3) ! CALL INDEX_UNIFRM2(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) CALL INDEX_AFFECT (ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) DO JM=1,4!B1 IIMAX = IIE IJMAX = IJE IF (JM==2) IIMAX=IIMAX+1 IF (JM==3) IJMAX=IJMAX+1 IF (JM==4) IIMAX=IIMAX+1 IF (JM==4) IJMAX=IJMAX+1 ZTMP2(:,:,JM) = ZSURF(:,:,JM) ! DO KLOOP=-1,1,2 KLOOP=1 DO JI=IIB,IIMAX!E1 DO JJ=IJB,IJMAX!F1 IF ((ABS(ZINDI(JI,JJ,JM)-1.*KLOOP)).GT.XIBM_EPSI) GO TO 445 ZMAX2 = MAX(0.,ZSURF(JI,JJ,JM)*KLOOP) JIM2=MAX(JI-1,1) JJM2=MAX(JJ-1,1) JIP2=MIN(JI+1,IIU) JJP2=MIN(JJ+1,IJU) DO JI2=JIM2,JIP2!G3 DO JJ2=JJM2,JJP2!H3 ZTMP2(JI2,JJ2,JM)=ZMAX2 ENDDO!H4 ENDDO!G4 445 CONTINUE ENDDO!F2 ENDDO!E2 ! ENDDO!D2 ZSURF(:,:,JM) = ZTMP2(:,:,JM) NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,JM)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ENDDO!B2 CALL INDEX_UNIFRM1(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL,ZHEI2,ZTMP3) ! CALL INDEX_UNIFRM2(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) DO JM=1,4!B1 IIMAX = IIE IJMAX = IJE IF (JM==2) IIMAX=IIMAX+1 IF (JM==3) IJMAX=IJMAX+1 IF (JM==4) IIMAX=IIMAX+1 IF (JM==4) IJMAX=IJMAX+1 ZTMP2(:,:,JM) = ZSURF(:,:,JM) DO JI=IIB,IIMAX!E1 DO JJ=IJB,IJMAX!F1 IF ((ABS(ZSURF(JI,JJ,JM))).GT.-XIBM_EPSI) GO TO 4466 JIM2=MAX(JI-1,1) JJM2=MAX(JJ-1,1) JIP2=MIN(JI+1,IIU) JJP2=MIN(JJ+1,IJU) ZMAX2=ZSURF(JI,JJ,JM) IF ((ABS(ZSURF(JIM2,JJ ,JM)).LT.XIBM_EPSI).AND.(ABS(ZSURF(JIP2,JJ ,JM))).LT.XIBM_EPSI) ZMAX2=0. IF ((ABS(ZSURF(JI ,JJM2,JM)).LT.XIBM_EPSI).AND.(ABS(ZSURF(JI ,JJP2,JM))).LT.XIBM_EPSI) ZMAX2=0. IF ((ABS(ZSURF(JIM2,JJM2,JM)).LT.XIBM_EPSI).AND.(ABS(ZSURF(JIP2,JJP2,JM))).LT.XIBM_EPSI) ZMAX2=0. IF ((ABS(ZSURF(JIM2,JJP2,JM)).LT.XIBM_EPSI).AND.(ABS(ZSURF(JIP2,JJM2,JM))).LT.XIBM_EPSI) ZMAX2=0. IF ((ABS(ZSURF(JIM2,JJM2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JI ,JJP2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JIP2,JJ ,JM)).LT.XIBM_EPSI)) ZMAX2=0. IF ((ABS(ZSURF(JIM2,JJP2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JI ,JJM2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JIP2,JJ ,JM)).LT.XIBM_EPSI)) ZMAX2=0. IF ((ABS(ZSURF(JIP2,JJM2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JI ,JJP2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JIM2,JJ ,JM)).LT.XIBM_EPSI)) ZMAX2=0. IF ((ABS(ZSURF(JIP2,JJP2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JI ,JJM2,JM)).LT.XIBM_EPSI).AND.& (ABS(ZSURF(JIM2,JJ ,JM)).LT.XIBM_EPSI)) ZMAX2=0. ZTMP2(JI,JJ,JM)=ZMAX2 4466 CONTINUE ENDDO!F2 ENDDO!E2 DO JI=IIB,IIMAX!E1 DO JJ=IJB,IJMAX!F1 IF ((ABS(ZSURF(JI,JJ,JM))).GT.XIBM_EPSI) GO TO 446 JIM2=MAX(JI-1,1) JJM2=MAX(JJ-1,1) JIP2=MIN(JI+1,IIU) JJP2=MIN(JJ+1,IJU) ZMAX2=ZSURF(JI,JJ,JM) IF ((ABS(ZSURF(JIM2,JJ ,JM))*ABS(ZSURF(JIP2,JJ ,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.5*(ABS(ZSURF(JIM2,JJ ,JM))+ABS(ZSURF(JIP2,JJ ,JM)))) IF ((ABS(ZSURF(JI ,JJM2,JM))*ABS(ZSURF(JI ,JJP2,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.5*(ABS(ZSURF(JI ,JJM2,JM))+ABS(ZSURF(JI ,JJP2,JM)))) IF ((ABS(ZSURF(JIM2,JJM2,JM))*ABS(ZSURF(JIP2,JJP2,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.5*(ABS(ZSURF(JIM2,JJM2,JM))+ABS(ZSURF(JIP2,JJP2,JM)))) IF ((ABS(ZSURF(JIM2,JJP2,JM))*ABS(ZSURF(JIP2,JJM2,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.5*(ABS(ZSURF(JIM2,JJP2,JM))+ABS(ZSURF(JIP2,JJM2,JM)))) IF ((ABS(ZSURF(JIM2,JJM2,JM))*ABS(ZSURF(JI,JJP2,JM))*ABS(ZSURF(JIP2,JJ,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.333*(ABS(ZSURF(JIM2,JJM2,JM))+ABS(ZSURF(JI,JJP2,JM)+ABS(ZSURF(JIP2,JJ,JM))))) IF ((ABS(ZSURF(JIM2,JJP2,JM))*ABS(ZSURF(JI,JJM2,JM))*ABS(ZSURF(JIP2,JJ,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.333*(ABS(ZSURF(JIM2,JJP2,JM))+ABS(ZSURF(JI,JJM2,JM)+ABS(ZSURF(JIP2,JJ,JM))))) IF ((ABS(ZSURF(JIP2,JJM2,JM))*ABS(ZSURF(JI,JJP2,JM))*ABS(ZSURF(JIM2,JJ,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.333*(ABS(ZSURF(JIP2,JJM2,JM))+ABS(ZSURF(JI,JJP2,JM)+ABS(ZSURF(JIM2,JJ,JM))))) IF ((ABS(ZSURF(JIP2,JJP2,JM))*ABS(ZSURF(JI,JJM2,JM))*ABS(ZSURF(JIM2,JJ,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.333*(ABS(ZSURF(JIP2,JJP2,JM))+ABS(ZSURF(JI,JJM2,JM)+ABS(ZSURF(JIM2,JJ,JM))))) ZTMP2(JI,JJ,JM)=ZMAX2 446 CONTINUE ENDDO!F2 ENDDO!E2 ZSURF(:,:,JM) = ZTMP2(:,:,JM) NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,JM)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ENDDO!B2 CALL INDEX_UNIFRM1(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL,ZHEI2,ZTMP3) ! CALL INDEX_UNIFRM2(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) DO JM=1,4!B1 IIMAX = IIE IJMAX = IJE IF (JM==2) IIMAX=IIMAX+1 IF (JM==3) IJMAX=IJMAX+1 IF (JM==4) IIMAX=IIMAX+1 IF (JM==4) IJMAX=IJMAX+1 ZTMP2(:,:,JM) = ZSURF(:,:,JM) DO JI=IIB,IIMAX!E1 DO JJ=IJB,IJMAX!F1 IF ((ABS(ZSURF(JI,JJ,JM))).GT.XIBM_EPSI) GO TO 447 JIM2=MAX(JI-1,1) JJM2=MAX(JJ-1,1) JIP2=MIN(JI+1,IIU) JJP2=MIN(JJ+1,IJU) ZMAX2=ZSURF(JI,JJ,JM) IF ((ABS(ZSURF(JIM2,JJM2,JM))*ABS(ZSURF(JIP2,JJP2,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.5*(ABS(ZSURF(JIM2,JJM2,JM))+ABS(ZSURF(JIP2,JJP2,JM)))) IF ((ABS(ZSURF(JIM2,JJP2,JM))*ABS(ZSURF(JIP2,JJM2,JM))).GT.XIBM_EPSI) ZMAX2= MAX(ZMAX2, 0.5*(ABS(ZSURF(JIM2,JJP2,JM))+ABS(ZSURF(JIP2,JJM2,JM)))) ZTMP2(JI,JJ,JM)=ZMAX2 447 CONTINUE ENDDO!F2 ENDDO!E2 ZSURF(:,:,JM) = ZTMP2(:,:,JM) NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,ZSURF(:,:,JM)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ENDDO!B2 CALL INDEX_UNIFRM1(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL,ZHEI2,ZTMP3) ! CALL INDEX_UNIFRM2(ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) CALL INDEX_AFFECT (ZSURF,ZINDI,XIBM_EPSI,IIB,IIE,IJB,IJE,IIBM_LEVEL) DO JM=1,7 IIMAX = IIE IJMAX = IJE IKMAX = IKE IF (JM==2.OR.JM==5.OR.JM==6) IIMAX = IIMAX+1 IF (JM==3.OR.JM==5.OR.JM==7) IJMAX = IJMAX+1 IF (JM==4.OR.JM==7.OR.JM==6) IKMAX = IKMAX+1 DO JI=IIB,IIMAX IF (JM==1) ZXX1 = (XXHAT(JI)+XXHAT(JI+1))/2. IF (JM==2) ZXX1 = (XXHAT(JI)+XXHAT(JI ))/2. IF (JM==3) ZXX1 = (XXHAT(JI)+XXHAT(JI+1))/2. IF (JM==4) ZXX1 = (XXHAT(JI)+XXHAT(JI+1))/2. IF (JM==5) ZXX1 = (XXHAT(JI)+XXHAT(JI ))/2. IF (JM==6) ZXX1 = (XXHAT(JI)+XXHAT(JI ))/2. IF (JM==7) ZXX1 = (XXHAT(JI)+XXHAT(JI+1))/2. JI2_MIN=JI-10 JI2_MAX=JI+10 JI2_MIN=MAX(1,JI2_MIN) JI2_MAX=MIN(IIU,JI2_MAX) DO JJ=IJB,IJMAX IF (JM==1) ZYY1 = (XYHAT(JJ)+XYHAT(JJ+1))/2. IF (JM==2) ZYY1 = (XYHAT(JJ)+XYHAT(JJ+1))/2. IF (JM==3) ZYY1 = (XYHAT(JJ)+XYHAT(JJ ))/2. IF (JM==4) ZYY1 = (XYHAT(JJ)+XYHAT(JJ+1))/2. IF (JM==5) ZYY1 = (XYHAT(JJ)+XYHAT(JJ ))/2. IF (JM==6) ZYY1 = (XYHAT(JJ)+XYHAT(JJ+1))/2. IF (JM==7) ZYY1 = (XYHAT(JJ)+XYHAT(JJ ))/2. JJ2_MIN=JJ-10 JJ2_MAX=JJ+10 JJ2_MIN=MAX(1,JJ2_MIN) JJ2_MAX=MIN(IJU,JJ2_MAX) DO JK=IKB,IKMAX IF (JM==1) ZZZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK+1))/2. IF (JM==2) ZZZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK+1))/2. IF (JM==3) ZZZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK+1))/2. IF (JM==4) ZZZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK))/2. IF (JM==5) ZZZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK+1))/2. IF (JM==6) ZZZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK))/2. IF (JM==7) ZZZ1 = (XZZ(JI,JJ,JK)+XZZ(JI,JJ,JK))/2. ! height limitation PPHI(JI,JJ,JK,JM)=ZZZ1+ZTES4*IIBM_LEVEL IF (ZZZ1>ZHIGH) GO TO 888 ! loop on each surface node - absolute distance (B14) DO JMM=1,4 DO JI2=JI2_MIN,JI2_MAX DO JJ2=JJ2_MIN,JJ2_MAX IF ((ZINDI(JI2,JJ2,JMM)-0.).LT.XIBM_EPSI) GO TO 666 ! surface coordinate (B15) ZZZ2 = ZSURF(JI2,JJ2,JMM) IF (ZINDI(JI2,JJ2,JMM).LT.(1.+XIBM_EPSI)) ZZZ2 = MIN(ZZZ1,ZSURF(JI2,JJ2,JMM)) IF (JMM==1) THEN ZXX2 = (XXHAT(JI2)+XXHAT(JI2+1))/2. ZYY2 = (XYHAT(JJ2)+XYHAT(JJ2+1))/2. IF (LWEST_ll ().AND.(JI2== 1)) ZXX2 = XXHAT(JI2+1)-(XXHAT(JI2+2)-XXHAT(JI2+1))/2. IF (LEAST_ll ().AND.(JI2==IIU-1)) ZXX2 = XXHAT(JI2-1)+(XXHAT(JI2-1)-XXHAT(JI2-2))/2.*3. IF (LSOUTH_ll().AND.(JJ2== 1)) ZYY2 = XYHAT(JJ2+1)-(XYHAT(JJ2+2)-XYHAT(JJ2+1))/2. IF (LNORTH_ll().AND.(JJ2==IJU-1)) ZYY2 = XYHAT(JJ2-1)+(XYHAT(JJ2-1)-XYHAT(JJ2-2))/2.*3. ENDIF IF (JMM==2) THEN ZXX2 = (XXHAT(JI2)+XXHAT(JI2 ))/2. ZYY2 = (XYHAT(JJ2)+XYHAT(JJ2+1))/2. IF (LWEST_ll ().AND.(JI2== 1)) ZXX2 = XXHAT(JI2+1)-(XXHAT(JI2+2)-XXHAT(JI2+1))/1. IF (LEAST_ll ().AND.(JI2==IIU-1)) ZXX2 = XXHAT(JI2-1)+(XXHAT(JI2-1)-XXHAT(JI2-2))/1. IF (LSOUTH_ll().AND.(JJ2== 1)) ZYY2 = XYHAT(JJ2+1)-(XYHAT(JJ2+2)-XYHAT(JJ2+1))/2. IF (LNORTH_ll().AND.(JJ2==IJU-1)) ZYY2 = XYHAT(JJ2-1)+(XYHAT(JJ2-1)-XYHAT(JJ2-2))/2.*3. ENDIF IF (JMM==3) THEN ZXX2 = (XXHAT(JI2)+XXHAT(JI2+1))/2. ZYY2 = (XYHAT(JJ2)+XYHAT(JJ2 ))/2. IF (LWEST_ll ().AND.(JI2== 1)) ZXX2 = XXHAT(JI2+1)-(XXHAT(JI2+2)-XXHAT(JI2+1))/2. IF (LEAST_ll ().AND.(JI2==IIU-1)) ZXX2 = XXHAT(JI2-1)+(XXHAT(JI2-1)-XXHAT(JI2-2))/2.*3. IF (LSOUTH_ll().AND.(JJ2== 1)) ZYY2 = XYHAT(JJ2+1)-(XYHAT(JJ2+2)-XYHAT(JJ2+1))/1. IF (LNORTH_ll().AND.(JJ2==IJU-1)) ZYY2 = XYHAT(JJ2-1)+(XYHAT(JJ2-1)-XYHAT(JJ2-2))/1. ENDIF IF (JMM==4) THEN ZXX2 = (XXHAT(JI2)+XXHAT(JI2))/2. ZYY2 = (XYHAT(JJ2)+XYHAT(JJ2))/2. IF (LWEST_ll ().AND.(JI2== 1)) ZXX2 = XXHAT(JI2+1)-(XXHAT(JI2+2)-XXHAT(JI2+1))/1. IF (LEAST_ll ().AND.(JI2==IIU-1)) ZXX2 = XXHAT(JI2-1)+(XXHAT(JI2-1)-XXHAT(JI2-2))/1. IF (LSOUTH_ll().AND.(JJ2== 1)) ZYY2 = XYHAT(JJ2+1)-(XYHAT(JJ2+2)-XYHAT(JJ2+1))/1. IF (LNORTH_ll().AND.(JJ2==IJU-1)) ZYY2 = XYHAT(JJ2-1)+(XYHAT(JJ2-1)-XYHAT(JJ2-2))/1. ENDIF !(E15) ZDIS = ((ZXX1-ZXX2)**2.+(ZYY1-ZYY2)**2.+(ZZZ1-ZZZ2)**2.)**0.5 PPHI(JI,JJ,JK,JM)=MIN(PPHI(JI,JJ,JK,JM),ZDIS) ZTES3 = ((ZXX1-ZXX2)**2.+(ZYY1-ZYY2)**2.)**0.5 IF ((ZTES3.LT.0.355*ZTES4) .AND. ((ZZZ1-ZSURF(JI2,JJ2,JMM)).LT.XIBM_EPSI) .AND. (ABS(ZINDI(JI2,JJ2,JMM)-1.).LT.XIBM_EPSI)) THEN ZTMP(JI,JJ,JK,JM) = +1. ENDIF IF ((ZTES3.LT.0.710*ZTES4) .AND. ((ZZZ1-ZSURF(JI2,JJ2,JMM)).LT.XIBM_EPSI) .AND. (ZINDI(JI2,JJ2,JMM).GT.(1.+XIBM_EPSI))) THEN ZTMP(JI,JJ,JK,JM) = +1. ENDIF 666 CONTINUE ENDDO ENDDO ENDDO !(E14) 888 CONTINUE ENDDO ENDDO ENDDO ENDDO !(E12) ! LevelSet uniformization PPHI = PPHI*ZTMP IF (HIBM_TYPE=='IDRE') THEN WHERE(ZPHI(:,:,:,:).GT.PPHI(:,:,:,:)) PPHI(:,:,:,:)=ZPHI(:,:,:,:) DEALLOCATE(ZPHI) ENDIF ! CALL LEVEL_UNIFRM(PPHI,XIBM_EPSI,IIB,IIE,IJB,IJE,IKB,IKE) ENDIF !(E0) ! !------------------------------------------------------------------------------ ! !**** X. DEALLOCATIONS/CLOSES ! ----------------------- ! IF (HIBM_TYPE=='REAL'.or.HIBM_TYPE=='IDRE') THEN DEALLOCATE(ZSURF,ZINDI,ZTMP,ZTMP2,ZTMP3) ENDIF IF (HIBM_TYPE=='GENE') THEN CALL CLOSE_ll('ibm_gene.nam',IOSTAT=IRESPIBMGENER) DEALLOCATE(ZIBM_XYZ1) ENDIF ! IF (HIBM_TYPE=='IDEA'.or.HIBM_TYPE=='IDRE'.or.HIBM_TYPE=='GEID') THEN CALL CLOSE_ll('ibm_idea.nam',IOSTAT=IRESPIBMIDEAL) DEALLOCATE(ZIBM_XYZ2) ENDIF ! IF (HIBM_TYPE=='GEID') THEN CALL CLOSE_ll('ibm_gene.nam',IOSTAT=IRESPIBMGENER) CALL CLOSE_ll('ibm_idea.nam',IOSTAT=IRESPIBMIDEAL) DEALLOCATE(ZIBM_XYZ1,ZIBM_XYZ2) ENDIF ! RETURN ! CONTAINS SUBROUTINE LEVEL_UNIFRM(PPHI,PIBM_EPSI,KIB,KIE,KJB,KJE,KKB,KKE) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll ! REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT):: PPHI REAL ,INTENT(IN) :: PIBM_EPSI INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KKB,KKE REAL, DIMENSION(:,:,:,:) ,ALLOCATABLE :: ZLEV TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll,JL INTEGER :: IIU,IJU,IKU ! initialization ALLOCATE(ZLEV(SIZE(PPHI,1),SIZE(PPHI,2),SIZE(PPHI,3),SIZE(PPHI,4))) IIU=SIZE(PPHI,1) IJU=SIZE(PPHI,2) IKU=SIZE(PPHI,3) ! Boundary symmetry IF (LWEST_ll ()) PPHI(1 ,:,:,1) = PPHI( 2,:,:,1) IF (LEAST_ll ()) PPHI(IIU,:,:,1) = PPHI(IIU-1,:,:,1) IF (LSOUTH_ll()) PPHI(:,1 ,:,1) = PPHI(:, 2,:,1) IF (LNORTH_ll()) PPHI(:,IJU,:,1) = PPHI(:,IJU-1,:,1) PPHI(:,:,1 ,1) = PPHI(:,:, 2,1)!*2.-PPHI(:,:, 3,1)*1. PPHI(:,:,IKU,1) = PPHI(:,:,IKU-1,1) IF (LSOUTH_ll()) PPHI(:,1 ,:,2) = PPHI(:, 2,:,2) IF (LNORTH_ll()) PPHI(:,IJU,:,2) = PPHI(:,IJU-1,:,2) PPHI(:,:,1 ,2) = PPHI(:,:, 2,2)!*2.-PPHI(:,:, 3,2)*1. PPHI(:,:,IKU,2) = PPHI(:,:,IKU-1,2) IF (LWEST_ll ()) PPHI(1 ,:,:,3) = PPHI( 2,:,:,3) IF (LEAST_ll ()) PPHI(IIU,:,:,3) = PPHI(IIU-1,:,:,3) PPHI(:,:,1 ,3) = PPHI(:,:, 2,3)!*2.-PPHI(:,:, 3,3)*1. PPHI(:,:,IKU,3) = PPHI(:,:,IKU-1,3) IF (LWEST_ll ()) PPHI(1 ,:,:,4) = PPHI( 2,:,:,4) IF (LEAST_ll ()) PPHI(IIU,:,:,4) = PPHI(IIU-1,:,:,4) IF (LSOUTH_ll()) PPHI(:,1 ,:,4) = PPHI(:, 2,:,4) IF (LNORTH_ll()) PPHI(:,IJU,:,4) = PPHI(:,IJU-1,:,4) IF (LWEST_ll ()) PPHI(1 ,:,:,2) = PPHI(2 ,:,:,2) IF (LEAST_ll ()) PPHI(IIU,:,:,2) = PPHI(IIU-1,:,:,2) IF (LSOUTH_ll()) PPHI(:,1 ,:,3) = PPHI(:,2 ,:,3) IF (LNORTH_ll()) PPHI(:,IJU,:,3) = PPHI(:,IJU-1,:,3) PPHI(:,:,1 ,4) = PPHI(:,:,2 ,4)!*2.-PPHI(:,:, 3,4)*1. PPHI(:,:,IKU,4) = PPHI(:,:,IKU-1,4) DO JL=5,7 IF (LWEST_ll ()) PPHI(1 ,:,:,JL) = PPHI( 2,:,:,JL)!*2.-PPHI( 3,:,:,JL) IF (LEAST_ll ()) PPHI(IIU,:,:,JL) = PPHI(IIU-1,:,:,JL)!*2.-PPHI(IIU-2,:,:,JL) IF (LSOUTH_ll()) PPHI(:,1 ,:,JL) = PPHI(:, 2,:,JL)!*2.-PPHI(:, 3,:,JL) IF (LNORTH_ll()) PPHI(:,IJU,:,JL) = PPHI(:,IJU-1,:,JL)!*2.-PPHI(:,IJU-2,:,JL) PPHI(:,:,1 ,JL) = PPHI(:,:, 2,JL)!*2.-PPHI(:,:, 3,JL) PPHI(:,:,IKU,JL) = PPHI(:,:,IKU-1,JL)!*2.-PPHI(:,:,IKU-2,JL) ENDDO ! communication NULLIFY(TZFIELDS_ll) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,1)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,2)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,3)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,4)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,5)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,6)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,7)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ZLEV = PPHI WHERE ((((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1))*(ZLEV(KIB+1:KIE+1,KJB:KJE,KKB:KKE,2)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1))*(ZLEV(KIB:KIE,KJB+1:KJE+1,KKB:KKE,3)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1))*(ZLEV(KIB:KIE,KJB:KJE,KKB+1:KKE+1,4)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1))).GT.XIBM_EPSI)) PPHI(KIB:KIE,KJB:KJE,KKB:KKE,1)=((1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2)+ZLEV(KIB+1:KIE+1,KJB :KJE ,KKB :KKE ,2))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3)+ZLEV(KIB :KIE ,KJB+1:KJE+1,KKB :KKE ,3))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4)+ZLEV(KIB :KIE ,KJB :KJE ,KKB+1:KKE+1,4)))*0.5+0.5*ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1) ENDWHERE WHERE ((((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2))*(ZLEV(KIB-1:KIE-1,KJB:KJE,KKB:KKE,1)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2))*(ZLEV(KIB:KIE,KJB+1:KJE+1,KKB:KKE,5)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2))*(ZLEV(KIB:KIE,KJB:KJE,KKB+1:KKE+1,6)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2))).GT.XIBM_EPSI)) PPHI(KIB:KIE+1,KJB:KJE,KKB:KKE,2)=((1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1)+ZLEV(KIB-1:KIE-1,KJB :KJE ,KKB :KKE ,1))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5)+ZLEV(KIB :KIE ,KJB+1:KJE+1,KKB :KKE ,5))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6)+ZLEV(KIB :KIE ,KJB :KJE ,KKB+1:KKE+1,6)))*0.5+0.5*ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,2) ENDWHERE WHERE ((((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3))*(ZLEV(KIB+1:KIE+1,KJB:KJE,KKB:KKE,5)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3))*(ZLEV(KIB:KIE,KJB-1:KJE-1,KKB:KKE,1)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3))*(ZLEV(KIB:KIE,KJB:KJE,KKB+1:KKE+1,7)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3))).GT.XIBM_EPSI)) PPHI(KIB:KIE,KJB:KJE,KKB:KKE,3)=((1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5)+ZLEV(KIB+1:KIE+1,KJB :KJE ,KKB :KKE ,5))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1)+ZLEV(KIB :KIE ,KJB-1:KJE-1,KKB :KKE ,1))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7)+ZLEV(KIB :KIE ,KJB :KJE ,KKB+1:KKE+1,7)))*0.5+0.5*ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,3) ENDWHERE WHERE ((((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4))*(ZLEV(KIB+1:KIE+1,KJB:KJE,KKB:KKE,6)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4))*(ZLEV(KIB:KIE,KJB+1:KJE+1,KKB:KKE,7)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4))*(ZLEV(KIB:KIE,KJB:KJE,KKB-1:KKE-1,1)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4))).GT.XIBM_EPSI)) PPHI(KIB:KIE,KJB:KJE,KKB:KKE,4)=((1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6)+ZLEV(KIB+1:KIE+1,KJB :KJE ,KKB :KKE ,6))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7)+ZLEV(KIB :KIE ,KJB+1:KJE+1,KKB :KKE ,7))+& (1./6.)*(ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,1)+ZLEV(KIB :KIE ,KJB :KJE ,KKB-1:KKE-1,1)))*0.5+0.5*ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,4) ENDWHERE WHERE ((((ZLEV(KIB:KIE,KJB:KJE,KKB :KKE ,3)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5))*(ZLEV(KIB-1:KIE-1,KJB:KJE,KKB:KKE,3)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB :KKE ,2)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5))*(ZLEV(KIB:KIE,KJB-1:KJE-1,KKB:KKE,2)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB:KJE,KKB-1:KKE-1,5)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5))*(ZLEV(KIB:KIE,KJB:KJE,KKB+1:KKE+1,5)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5))).GT.XIBM_EPSI)) PPHI(KIB:KIE,KJB:KJE,KKB:KKE,5)=((2./10.)*(ZLEV(KIB:KIE,KJB:KJE,KKB :KKE ,3)+ZLEV(KIB-1:KIE-1,KJB :KJE ,KKB :KKE ,3))+& (2./10.)*(ZLEV(KIB:KIE,KJB:KJE,KKB :KKE ,2)+ZLEV(KIB :KIE ,KJB-1:KJE-1,KKB :KKE ,2))+& (1./10.)*(ZLEV(KIB:KIE,KJB:KJE,KKB-1:KKE-1,5)+ZLEV(KIB :KIE ,KJB :KJE ,KKB+1:KKE+1,5)))*0.5+0.5*ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,5) ENDWHERE WHERE ((((ZLEV(KIB:KIE,KJB :KJE ,KKB:KKE,4)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6))*(ZLEV(KIB-1:KIE-1,KJB:KJE,KKB:KKE,4)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB-1:KJE-1,KKB:KKE,6)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6))*(ZLEV(KIB:KIE,KJB+1:KJE+1,KKB:KKE,6)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB:KIE,KJB :KJE ,KKB:KKE,2)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6))*(ZLEV(KIB:KIE,KJB:KJE,KKB-1:KKE-1,2)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6))).GT.XIBM_EPSI)) PPHI(KIB:KIE,KJB:KJE,KKB:KKE,6)=((2./10.)*(ZLEV(KIB:KIE,KJB :KJE ,KKB:KKE,4)+ZLEV(KIB-1:KIE-1,KJB :KJE ,KKB :KKE ,4))+& (1./10.)*(ZLEV(KIB:KIE,KJB-1:KJE-1,KKB:KKE,6)+ZLEV(KIB :KIE ,KJB+1:KJE+1,KKB :KKE ,6))+& (2./10.)*(ZLEV(KIB:KIE,KJB :KJE ,KKB:KKE,2)+ZLEV(KIB :KIE ,KJB :KJE ,KKB-1:KKE-1,2)))*0.5+0.5*ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,6) ENDWHERE WHERE ((((ZLEV(KIB-1:KIE-1,KJB:KJE,KKB:KKE,7)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7))*(ZLEV(KIB+1:KIE+1,KJB:KJE,KKB:KKE,7)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB :KIE ,KJB:KJE,KKB:KKE,4)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7))*(ZLEV(KIB:KIE,KJB-1:KJE-1,KKB:KKE,4)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7))).GT.XIBM_EPSI).AND.& (((ZLEV(KIB :KIE ,KJB:KJE,KKB:KKE,3)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7))*(ZLEV(KIB:KIE,KJB:KJE,KKB-1:KKE-1,3)-ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7))).GT.XIBM_EPSI)) PPHI(KIB:KIE,KJB:KJE,KKB:KKE,7)=((1./10.)*(ZLEV(KIB-1:KIE-1,KJB:KJE,KKB:KKE,7)+ZLEV(KIB+1:KIE+1,KJB :KJE ,KKB :KKE ,7))+& (2./10.)*(ZLEV(KIB :KIE ,KJB:KJE,KKB:KKE,4)+ZLEV(KIB :KIE ,KJB-1:KJE-1,KKB :KKE ,4))+& (2./10.)*(ZLEV(KIB :KIE ,KJB:KJE,KKB:KKE,3)+ZLEV(KIB :KIE ,KJB :KJE ,KKB-1:KKE-1,3)))*0.5+0.5*ZLEV(KIB:KIE,KJB:KJE,KKB:KKE,7) ENDWHERE ! Boundary symmetry IF (LWEST_ll ()) PPHI(1 ,:,:,1) = PPHI( 2,:,:,1) IF (LEAST_ll ()) PPHI(IIU,:,:,1) = PPHI(IIU-1,:,:,1) IF (LSOUTH_ll()) PPHI(:,1 ,:,1) = PPHI(:, 2,:,1) IF (LNORTH_ll()) PPHI(:,IJU,:,1) = PPHI(:,IJU-1,:,1) PPHI(:,:,1 ,1) = PPHI(:,:, 2,1)!*2.-PPHI(:,:, 3,1)*1. PPHI(:,:,IKU,1) = PPHI(:,:,IKU-1,1) IF (LSOUTH_ll()) PPHI(:,1 ,:,2) = PPHI(:, 2,:,2) IF (LNORTH_ll()) PPHI(:,IJU,:,2) = PPHI(:,IJU-1,:,2) PPHI(:,:,1 ,2) = PPHI(:,:, 2,2)!*2.-PPHI(:,:, 3,2)*1. PPHI(:,:,IKU,2) = PPHI(:,:,IKU-1,2) IF (LWEST_ll ()) PPHI(1 ,:,:,3) = PPHI( 2,:,:,3) IF (LEAST_ll ()) PPHI(IIU,:,:,3) = PPHI(IIU-1,:,:,3) PPHI(:,:,1 ,3) = PPHI(:,:, 2,3)!*2.-PPHI(:,:, 3,3)*1. PPHI(:,:,IKU,3) = PPHI(:,:,IKU-1,3) IF (LWEST_ll ()) PPHI(1 ,:,:,4) = PPHI( 2,:,:,4) IF (LEAST_ll ()) PPHI(IIU,:,:,4) = PPHI(IIU-1,:,:,4) IF (LSOUTH_ll()) PPHI(:,1 ,:,4) = PPHI(:, 2,:,4) IF (LNORTH_ll()) PPHI(:,IJU,:,4) = PPHI(:,IJU-1,:,4) IF (LWEST_ll ()) PPHI(1 ,:,:,2) = PPHI(2 ,:,:,2) IF (LEAST_ll ()) PPHI(IIU,:,:,2) = PPHI(IIU-1,:,:,2) IF (LSOUTH_ll()) PPHI(:,1 ,:,3) = PPHI(:,2 ,:,3) IF (LNORTH_ll()) PPHI(:,IJU,:,3) = PPHI(:,IJU-1,:,3) PPHI(:,:,1 ,4) = PPHI(:,:,2 ,4)!*2.-PPHI(:,:, 3,4)*1. PPHI(:,:,IKU,4) = PPHI(:,:,IKU-1,4) DO JL=5,7 IF (LWEST_ll ()) PPHI(1 ,:,:,JL) = PPHI( 2,:,:,JL)!*2.-PPHI( 3,:,:,JL) IF (LEAST_ll ()) PPHI(IIU,:,:,JL) = PPHI(IIU-1,:,:,JL)!*2.-PPHI(IIU-2,:,:,JL) IF (LSOUTH_ll()) PPHI(:,1 ,:,JL) = PPHI(:, 2,:,JL)!*2.-PPHI(:, 3,:,JL) IF (LNORTH_ll()) PPHI(:,IJU,:,JL) = PPHI(:,IJU-1,:,JL)!*2.-PPHI(:,IJU-2,:,JL) PPHI(:,:,1 ,JL) = PPHI(:,:, 2,JL)!*2.-PPHI(:,:, 3,JL) PPHI(:,:,IKU,JL) = PPHI(:,:,IKU-1,JL)!*2.-PPHI(:,:,IKU-2,JL) ENDDO ! communication NULLIFY(TZFIELDS_ll) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,1)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,2)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,3)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,4)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,5)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,6)) CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,7)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! ! finalization DEALLOCATE(ZLEV) END SUBROUTINE LEVEL_UNIFRM SUBROUTINE INDEX_UNIFRM6(PSURF,PINDI,PIBM_EPSI,KIB,KIE,KJB,KJE,KIBM_LEVEL,PHEI) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll REAL, DIMENSION(:,:,:) ,INTENT(INOUT):: PSURF REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PINDI REAL ,INTENT(IN) :: PIBM_EPSI,PHEI INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KIBM_LEVEL REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZTMP1 INTEGER :: JM,JMM,JI,JJ,JI2,JJ2 INTEGER :: IIMAX,IJMAX INTEGER :: IIU,IJU INTEGER :: ITEMP1,ITEMP2 TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll ! initialization ALLOCATE(ZTMP1(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) IIU=SIZE(PSURF,1) IJU=SIZE(PSURF,2) ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,1).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,1).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = MAX(ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1),ZTMP1(KIB:KIE,KJB:KJE,1)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB:KJE,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB-1:KJE-1,1).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB-1:KIE-1,KJB:KJE,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB-1:KJE-1,1).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = MAX(ZTMP1(KIB-1:KIE-1,KJB:KJE,1),ZTMP1(KIB:KIE,KJB-1:KJE-1,1)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,4).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,4).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = MAX(ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4),ZTMP1(KIB:KIE,KJB:KJE,4)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB:KJE,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB+1:KIE+1,KJB:KJE,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB+1:KJE+1,4).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = MAX(ZTMP1(KIB+1:KIE+1,KJB:KJE,4),ZTMP1(KIB:KIE,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,2).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,2).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = MAX(ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2),ZTMP1(KIB:KIE,KJB:KJE,2)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB:KJE,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB-1:KJE-1,2).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB+1:KIE+1,KJB:KJE,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB-1:KJE-1,2).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = MAX(ZTMP1(KIB+1:KIE+1,KJB:KJE,2),ZTMP1(KIB:KIE,KJB-1:KJE-1,2)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,3).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB:KIE,KJB:KJE,3).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = MAX(ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3),ZTMP1(KIB:KIE,KJB:KJE,3)) ENDWHERE WHERE ((ZTMP1(KIB:KIE,KJB+1:KJE+1,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB-1:KIE-1,KJB:KJE,3).GT.PIBM_EPSI**0.5).OR.& (ZTMP1(KIB:KIE,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB-1:KIE-1,KJB:KJE,3).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = MAX(ZTMP1(KIB:KIE,KJB+1:KJE+1,3),ZTMP1(KIB-1:KIE-1,KJB:KJE,3)) ENDWHERE WHERE (PSURF(:,:,:).GT.XIBM_EPSI) PSURF(:,:,:)=MAX(PSURF(:,:,:),PHEI) ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! finalization DEALLOCATE(ZTMP1) END SUBROUTINE INDEX_UNIFRM6 SUBROUTINE INDEX_UNIFRM2(PSURF,PINDI,PIBM_EPSI,KIB,KIE,KJB,KJE,KIBM_LEVEL) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll REAL, DIMENSION(:,:,:) ,INTENT(INOUT):: PSURF REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PINDI REAL ,INTENT(IN) :: PIBM_EPSI INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KIBM_LEVEL REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZTMP1 INTEGER :: JM,JMM,JI,JJ,JI2,JJ2 INTEGER :: IIMAX,IJMAX INTEGER :: IIU,IJU INTEGER :: ITEMP1,ITEMP2 TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll ! initialization ALLOCATE(ZTMP1(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) IIU=SIZE(PSURF,1) IJU=SIZE(PSURF,2) ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).LT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB-1:KJE-1,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0. ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).LT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0. ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,2).LT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB-1:KJE-1,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0. ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).LT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0. ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.00!*(ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1)+ZTMP1(KIB :KIE ,KJB :KJE ,1)) ENDWHERE ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB-1:KJE-1,1).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.00!*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,1)+ZTMP1(KIB :KIE ,KJB-1:KJE-1,1)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.00!*(ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4)+ZTMP1(KIB :KIE ,KJB :KJE ,4)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.00!*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,4)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.00!*(ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3)+ZTMP1(KIB :KIE ,KJB :KJE ,3)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.00!*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,3)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,3)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,2).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.00!*(ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2)+ZTMP1(KIB :KIE ,KJB :KJE ,2)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB-1:KJE-1,2).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.00!*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB-1:KJE-1,2)) ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.00!*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,3)+ZTMP1(KIB :KIE ,KJB :KJE ,3)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB-1:KJE-1,2).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.00!*(ZTMP1(KIB :KIE ,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB-1:KJE-1,2)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.00!*(ZTMP1(KIB :KIE ,KJB+1:KJE+1,3)+ZTMP1(KIB :KIE ,KJB :KJE ,3)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,2).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.00!*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB :KJE ,2)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.00!*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,1)+ZTMP1(KIB :KIE ,KJB :KJE ,1)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.00!*(ZTMP1(KIB :KIE ,KJB :KJE ,4)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB-1:KJE-1,1).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.00!*(ZTMP1(KIB :KIE ,KJB-1:KJE-1,1)+ZTMP1(KIB :KIE ,KJB :KJE ,1)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).LT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).LT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.00!*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,4)+ZTMP1(KIB :KIE ,KJB :KJE ,4)) ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) DO JM=1,4 IF (LWEST_ll ()) PSURF(1 :KIB+4*KIBM_LEVEL,:,JM)=0. IF (LEAST_ll ()) PSURF(KIE-4*KIBM_LEVEL:IIU,:,JM)=0. IF (LSOUTH_ll()) PSURF(:,1 :KJB+4*KIBM_LEVEL,JM)=0. IF (LNORTH_ll()) PSURF(:,KJE-4*KIBM_LEVEL:IJU,JM)=0. ENDDO ! finalization DEALLOCATE(ZTMP1) END SUBROUTINE INDEX_UNIFRM2 SUBROUTINE INDEX_UNIFRM4(PSURF,PINDI,PIBM_EPSI,KIB,KIE,KJB,KJE,KIBM_LEVEL) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll REAL, DIMENSION(:,:,:) ,INTENT(INOUT):: PSURF REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PINDI REAL ,INTENT(IN) :: PIBM_EPSI INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KIBM_LEVEL REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZTMP1 INTEGER :: JM,JMM,JI,JJ,JI2,JJ2 INTEGER :: IIMAX,IJMAX INTEGER :: IIU,IJU INTEGER :: ITEMP1,ITEMP2 TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll ! initialization ALLOCATE(ZTMP1(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) IIU=SIZE(PSURF,1) IJU=SIZE(PSURF,2) ZTMP1 = PSURF WHERE (PINDI(KIB :KIE ,KJB :KJE ,2).LT.PIBM_EPSI.AND.PINDI(KIB+1:KIE+1,KJB :KJE ,2).LT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB :KJE ,3).LT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB+1:KJE+1,3).LT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,1) = 0. ENDWHERE ZTMP1 = PSURF WHERE (PINDI(KIB-1:KIE-1,KJB :KJE ,3).LT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,3).LT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB-1:KJE-1,2).LT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,2).LT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,4) = 0. ENDWHERE ZTMP1 = PSURF WHERE (PINDI(KIB-1:KIE-1,KJB :KJE ,1).LT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,1).LT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB :KJE ,4).LT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB+1:KJE+1,4).LT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,2) = 0. ENDWHERE ZTMP1 = PSURF WHERE (PINDI(KIB :KIE ,KJB-1:KJE-1,1).LT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,1).LT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB :KJE ,4).LT.PIBM_EPSI.AND.PINDI(KIB+1:KIE+1,KJB :KJE ,4).LT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,3) = 0. ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! finalization DEALLOCATE(ZTMP1) END SUBROUTINE INDEX_UNIFRM4 SUBROUTINE INDEX_UNIFRM0(PSURF,PINDI,PIBM_EPSI,KIB,KIE,KJB,KJE,KIBM_LEVEL,PHEI2) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll USE MODI_IBM_INTERPOS USE MODD_GRID USE MODD_CST USE MODD_GRID_n USE MODE_GRIDPROJ REAL, DIMENSION(:,:,:) ,INTENT(OUT) :: PSURF REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PINDI REAL ,INTENT(IN) :: PIBM_EPSI,PHEI2 INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KIBM_LEVEL REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZXREF,ZYREF,ZZREF,ZSURF INTEGER :: JM,JMM,JI,JJ,JI2,JJ2 INTEGER :: IIMAX,IJMAX INTEGER :: IIU,IJU INTEGER :: ITEMP1,ITEMP2 TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll CHARACTER(LEN=1) :: HPOS REAL :: ZLAT_SOUT ,ZLON_EAST,ZLAT_MINC ,ZLON_MINC ,ZLAT_MAXC, ZLON_MAXC REAL :: ZYYY_SOUT ,ZXXX_EAST,ZYYY_MINC ,ZXXX_MINC ,ZYYY_MAXC, ZXXX_MAXC REAL :: ZLAT_MIN2 ,ZLON_MIN2 ,ZLAT_MAX2, ZLON_MAX2,ZXXX_MINCC REAL :: ZYYY_MIN2 ,ZXXX_MIN2 ,ZYYY_MAX2, ZXXX_MAX2,ZYYY_MINCC ! initialization ALLOCATE(ZXREF(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) ALLOCATE(ZYREF(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) ALLOCATE(ZZREF(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) ALLOCATE(ZSURF(SIZE(PSURF,1),SIZE(PSURF,2),4)) IIU=SIZE(PSURF,1) IJU=SIZE(PSURF,2) ZLAT_SOUT = 43.559 ZLON_EAST = 1.4387 CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT_SOUT,ZLON_EAST,ZXXX_EAST,ZYYY_SOUT) ZLAT_MINC = 43.556 ZLON_MINC = 1.4400 ZLAT_MAXC = 43.573 ZLON_MAXC = 1.4480 CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT_MINC,ZLON_MINC,ZXXX_MINC,ZYYY_MINC) CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT_MAXC,ZLON_MAXC,ZXXX_MAXC,ZYYY_MAXC) ZXXX_MINCC = ZXXX_MAXC-ZXXX_MINC ZYYY_MINCC = ZYYY_MAXC-ZYYY_MINC ZLAT_MIN2 = 43.556 ZLON_MIN2 = 1.4000 ZLAT_MAX2 = 43.558 ZLON_MAX2 = 1.4480 CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT_MIN2,ZLON_MIN2,ZXXX_MIN2,ZYYY_MIN2) CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT_MAX2,ZLON_MAX2,ZXXX_MAX2,ZYYY_MAX2) PSURF(:,:,:)=0. ZSURF(:,:,:)=0. IF (0.>1.) THEN DO JM=1,4 IF (JM==1) CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,'P') IF (JM==2) CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,'U') IF (JM==3) CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,'V') IF (JM==4) CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,'W') WHERE (ZYREF(:,:,2).LT.ZYYY_SOUT) PSURF(:,:,JM)=PHEI2*(1.5+0.5*COS(ZXREF(:,:,2)/PHEI2/2.*3.14159)*SIN(ZYREF(:,:,2)/PHEI2/2.*3.14159)) ENDWHERE ZSURF(:,:,JM)= MAX(PSURF(:,:,JM),ZSURF(:,:,JM)) WHERE (ZXREF(:,:,2).GT.ZXXX_EAST) PSURF(:,:,JM)=PHEI2*(1.5+0.5*COS(ZXREF(:,:,2)/PHEI2/2.*3.14159)*SIN(ZYREF(:,:,2)/PHEI2/2.*3.14159)) ENDWHERE ZSURF(:,:,JM)= MAX(PSURF(:,:,JM),ZSURF(:,:,JM)) WHERE ((ZYREF(:,:,2).GT.ZYYY_MINC).AND.(ZYREF(:,:,2).LT.ZYYY_MAXC).AND.(ZXREF(:,:,2).GT.ZXXX_MINC).AND.(ZXREF(:,:,2).LT.ZXXX_MAXC)) PSURF(:,:,JM)=+50.*(3.14159*(1.- (ZXREF(:,:,2)-ZXXX_MINC)/ZXXX_MINCC))**4.*& sin(3.14159*(1.- (ZXREF(:,:,2)-ZXXX_MINC)/ZXXX_MINCC*& (1.-((ZYREF(:,:,2)-ZYYY_MINC)/ZYYY_MINCC)**4.)))/24.*& (1.9+0.1*COS(ZXREF(:,:,2)/PHEI2/2.*3.14159)*SIN(ZYREF(:,:,2)/PHEI2/2.*3.14159)) ENDWHERE ZSURF(:,:,JM)= MAX(PSURF(:,:,JM),ZSURF(:,:,JM)) WHERE ((ZYREF(:,:,2).GT.ZYYY_MIN2).AND.(ZYREF(:,:,2).LT.ZYYY_MAX2).AND.(ZXREF(:,:,2).GT.ZXXX_MIN2).AND.(ZXREF(:,:,2).LT.ZXXX_MAX2)) PSURF(:,:,JM)=5.*PHEI2*(1.9+0.1*COS(ZXREF(:,:,2)/PHEI2/2.*3.14159)*SIN(ZYREF(:,:,2)/PHEI2/2.*3.14159)) ENDWHERE ZSURF(:,:,JM)= MAX(PSURF(:,:,JM),ZSURF(:,:,JM)) ENDDO ENDIF PSURF = ZSURF ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! finalization DEALLOCATE(ZXREF,ZYREF,ZZREF,ZSURF) END SUBROUTINE INDEX_UNIFRM0 SUBROUTINE INDEX_UNIFRM1(PSURF,PINDI,PIBM_EPSI,KIB,KIE,KJB,KJE,KIBM_LEVEL,PHEI2,PBORD) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll USE MODI_IBM_INTERPOS REAL, DIMENSION(:,:,:) ,INTENT(INOUT):: PSURF REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PINDI,PBORD REAL ,INTENT(IN) :: PIBM_EPSI,PHEI2 INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KIBM_LEVEL REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZTMP1,ZINDI INTEGER :: JM,JMM,JI,JJ,JI2,JJ2 INTEGER :: IIMAX,IJMAX INTEGER :: IIU,IJU INTEGER :: ITEMP1,ITEMP2 TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll CHARACTER(LEN=1) :: HPOS ! initialization ALLOCATE(ZTMP1(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) ALLOCATE(ZINDI(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) IIU=SIZE(PSURF,1) IJU=SIZE(PSURF,2) ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB-1:KJE-1,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.25*(ZTMP1(KIB-1:KIE-1,KJB:KJE,3)+ZTMP1(KIB:KIE,KJB:KJE,3)+ZTMP1(KIB:KIE,KJB-1:KJE-1,2)+ZTMP1(KIB :KIE ,KJB :KJE ,2)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.25*(ZTMP1(KIB+1:KIE+1,KJB:KJE,2)+ZTMP1(KIB:KIE,KJB:KJE,2)+ZTMP1(KIB:KIE,KJB+1:KJE+1,3)+ZTMP1(KIB :KIE ,KJB :KJE ,3)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB-1:KJE-1,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.25*(ZTMP1(KIB+1:KIE+1,KJB:KJE,4)+ZTMP1(KIB:KIE,KJB:KJE,4)+ZTMP1(KIB:KIE,KJB-1:KJE-1,1)+ZTMP1(KIB :KIE ,KJB :KJE ,1)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).GT.PIBM_EPSI**0.5).AND.& (ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.25*(ZTMP1(KIB-1:KIE-1,KJB:KJE,1)+ZTMP1(KIB:KIE,KJB:KJE,1)+ZTMP1(KIB:KIE,KJB+1:KJE+1,4)+ZTMP1(KIB :KIE ,KJB :KJE ,4)) ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.50*(ZTMP1(KIB-1:KIE-1,KJB-1:KJE-1,1)+ZTMP1(KIB :KIE ,KJB :KJE ,1)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB-1:KJE-1,1).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.50*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,1)+ZTMP1(KIB :KIE ,KJB-1:KJE-1,1)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4)+ZTMP1(KIB :KIE ,KJB :KJE ,4)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,4)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.50*(ZTMP1(KIB-1:KIE-1,KJB+1:KJE+1,3)+ZTMP1(KIB :KIE ,KJB :KJE ,3)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.50*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,3)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,3)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB-1:KJE-1,2)+ZTMP1(KIB :KIE ,KJB :KJE ,2)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB-1:KJE-1,2).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB-1:KJE-1,2)) ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ZTMP1 = PSURF WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.50*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,3)+ZTMP1(KIB :KIE ,KJB :KJE ,3)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB-1:KJE-1,2).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,4) = 0.50*(ZTMP1(KIB :KIE ,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB-1:KJE-1,2)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB :KIE ,KJB+1:KJE+1,3)+ZTMP1(KIB :KIE ,KJB :KJE ,3)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB :KJE ,2)) ENDWHERE WHERE ((ZTMP1(KIB-1:KIE-1,KJB :KJE ,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.50*(ZTMP1(KIB-1:KIE-1,KJB :KJE ,1)+ZTMP1(KIB :KIE ,KJB :KJE ,1)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,2) = 0.50*(ZTMP1(KIB :KIE ,KJB :KJE ,4)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB-1:KJE-1,1).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,1).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.50*(ZTMP1(KIB :KIE ,KJB-1:KJE-1,1)+ZTMP1(KIB :KIE ,KJB :KJE ,1)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,3) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,4)+ZTMP1(KIB :KIE ,KJB :KJE ,4)) ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ZTMP1 = PSURF WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB :KIE ,KJB :KJE ,3)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB :KIE ,KJB :KJE ,3)+ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB :KIE ,KJB :KJE ,2)+ZTMP1(KIB+1:KIE+1,KJB :KJE ,4)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB :KIE ,KJB :KJE ,2)+ZTMP1(KIB+1:KIE+1,KJB+1:KJE+1,4)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB :KIE ,KJB+1:KJE+1,3)+ZTMP1(KIB :KIE ,KJB :KJE ,4)) ENDWHERE WHERE ((ZTMP1(KIB :KIE ,KJB+1:KJE+1,3).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB+1:KIE+1,KJB :KJE ,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB :KIE ,KJB+1:KJE+1,3)+ZTMP1(KIB+1:KIE+1,KJB :KJE ,4)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB :KJE ,4)) ENDWHERE WHERE ((ZTMP1(KIB+1:KIE+1,KJB :KJE ,2).GT.PIBM_EPSI**0.5).AND.(ZTMP1(KIB :KIE ,KJB+1:KJE+1,4).GT.PIBM_EPSI**0.5)) PSURF(KIB:KIE,KJB:KJE,1) = 0.50*(ZTMP1(KIB+1:KIE+1,KJB :KJE ,2)+ZTMP1(KIB :KIE ,KJB+1:KJE+1,4)) ENDWHERE ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) WHERE (PBORD(:,:,:).GT.XIBM_EPSI) PSURF(:,:,:)=PBORD(:,:,:) DO JM=1,4 IF (LWEST_ll ()) PSURF(1 :KIB+7*KIBM_LEVEL,:,JM)=0. IF (LEAST_ll ()) PSURF(KIE-7*KIBM_LEVEL:IIU,:,JM)=0. IF (LSOUTH_ll()) PSURF(:,1 :KJB+7*KIBM_LEVEL,JM)=0. IF (LNORTH_ll()) PSURF(:,KJE-7*KIBM_LEVEL:IJU,JM)=0. ENDDO ! finalization DEALLOCATE(ZTMP1,ZINDI) END SUBROUTINE INDEX_UNIFRM1 SUBROUTINE INDEX_UNIFRM3(PSURF,PINDI,PIBM_EPSI,KIB,KIE,KJB,KJE,KIBM_LEVEL) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll REAL, DIMENSION(:,:,:) ,INTENT(INOUT):: PSURF REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PINDI REAL ,INTENT(IN) :: PIBM_EPSI INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KIBM_LEVEL REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZTMP1,ZINDI INTEGER :: JM,JMM,JI,JJ,JI2,JJ2 INTEGER :: IIMAX,IJMAX INTEGER :: IIU,IJU INTEGER :: ITEMP1,ITEMP2 TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll ! initialization ALLOCATE(ZTMP1(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) ALLOCATE(ZINDI(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) IIU=SIZE(PSURF,1) IJU=SIZE(PSURF,2) ZTMP1 = PSURF WHERE (PINDI(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI.AND.PINDI(KIB+1:KIE+1,KJB :KJE ,2).GT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB+1:KJE+1,3).GT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,1) = MAX(PSURF(KIB:KIE,KJB:KJE,1),ZTMP1(KIB:KIE,KJB:KJE,2),ZTMP1(KIB+1:KIE+1,KJB:KJE,2),ZTMP1(KIB:KIE,KJB:KJE,3),ZTMP1(KIB:KIE,KJB+1:KJE+1,3)) ENDWHERE WHERE (PINDI(KIB-1:KIE-1,KJB :KJE ,3).GT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,3).GT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB-1:KJE-1,2).GT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,2).GT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,4) = MAX(PSURF(KIB:KIE,KJB:KJE,4),ZTMP1(KIB-1:KIE-1,KJB:KJE,3),ZTMP1(KIB:KIE,KJB:KJE,3),ZTMP1(KIB:KIE,KJB-1:KJE-1,2),ZTMP1(KIB:KIE,KJB:KJE,2)) ENDWHERE WHERE (PINDI(KIB-1:KIE-1,KJB :KJE ,1).GT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,1).GT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB+1:KJE+1,4).GT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,2) = MAX(PSURF(KIB:KIE,KJB:KJE,2),ZTMP1(KIB-1:KIE-1,KJB:KJE,1),ZTMP1(KIB:KIE,KJB:KJE,1),ZTMP1(KIB:KIE,KJB:KJE,4),ZTMP1(KIB:KIE,KJB+1:KJE+1,4)) ENDWHERE WHERE (PINDI(KIB :KIE ,KJB-1:KJE-1,1).GT.PIBM_EPSI.AND.PINDI(KIB :KIE ,KJB :KJE ,1).GT.PIBM_EPSI.AND.& PINDI(KIB :KIE ,KJB :KJE ,4).GT.PIBM_EPSI.AND.PINDI(KIB+1:KIE+1,KJB :KJE ,4).GT.PIBM_EPSI) PSURF(KIB:KIE,KJB:KJE,3) = MAX(PSURF(KIB:KIE,KJB:KJE,3),ZTMP1(KIB:KIE,KJB-1:KJE-1,1),ZTMP1(KIB:KIE,KJB:KJE,1),ZTMP1(KIB+1:KIE+1,KJB:KJE,4),ZTMP1(KIB:KIE,KJB:KJE,4)) ENDWHERE DO JM=1,4 IF (LWEST_ll ()) PSURF(1 :KIB+4*KIBM_LEVEL,:,JM)=0. IF (LEAST_ll ()) PSURF(KIE-4*KIBM_LEVEL:IIU,:,JM)=0. IF (LSOUTH_ll()) PSURF(:,1 :KJB+4*KIBM_LEVEL,JM)=0. IF (LNORTH_ll()) PSURF(:,KJE-4*KIBM_LEVEL:IJU,JM)=0. ENDDO ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PSURF(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! finalization DEALLOCATE(ZTMP1,ZINDI) END SUBROUTINE INDEX_UNIFRM3 SUBROUTINE INDEX_AFFECT(PSURF,PINDI,PIBM_EPSI,KIB,KIE,KJB,KJE,KIBM_LEVEL) USE MODE_POS USE MODE_ll USE MODE_IO_ll USE MODD_VAR_ll, ONLY: IP 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,XZZ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY USE MODD_LBC_n USE MODD_ARGSLIST_ll, ONLY : LIST_ll REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PSURF REAL, DIMENSION(:,:,:) ,INTENT(OUT) :: PINDI REAL ,INTENT(IN) :: PIBM_EPSI INTEGER ,INTENT(IN) :: KIB,KIE,KJB,KJE,KIBM_LEVEL REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZTEMP INTEGER :: JM,JMM,JI,JJ,JI2,JJ2,JIP1,JJP1,JIM1,JJM1 INTEGER :: IIMAX,IJMAX TYPE(LIST_ll), POINTER :: TZFIELDS_ll INTEGER :: IINFO_ll ! initialization ALLOCATE(ZTEMP(SIZE(PSURF,1),SIZE(PSURF,2),SIZE(PSURF,3))) PINDI(:,:,:)=0. WHERE(PSURF(:,:,:).GT.PIBM_EPSI) PINDI(:,:,:)=-1. ! 1/2 index affectation DO JMM=1,KIBM_LEVEL-1 ZTEMP = PINDI DO JM=1,4 IIMAX = KIE IJMAX = KJE IF (JM==2) IIMAX=IIMAX+1 IF (JM==3) IJMAX=IJMAX+1 IF (JM==4) IIMAX=IIMAX+1 IF (JM==4) IJMAX=IJMAX+1 DO JI=KIB,IIMAX DO JJ=KJB,IJMAX IF (ABS(ZTEMP(JI,JJ,JM)+1.).GT.(PIBM_EPSI)) GO TO 999 JIP1 = MIN(JI+1,SIZE(PSURF,1)) JJP1 = MIN(JJ+1,SIZE(PSURF,2)) JIM1=MAX(1,JI-1) JJM1=MAX(1,JJ-1) DO JI2=JIM1,JIP1 DO JJ2=JJM1,JJP1 IF (ABS(ZTEMP(JI2,JJ2,JM)-(JMM*1.-1.)).LT.(PIBM_EPSI)) PINDI(JI,JJ,JM)=JMM*1. ENDDO ENDDO 999 CONTINUE ENDDO ENDDO ENDDO ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ENDDO ! 3 index affectation ZTEMP = PINDI JMM = KIBM_LEVEL WHERE ((ABS(ZTEMP(:,:,:)+1.)).LT.(PIBM_EPSI)) PINDI(:,:,:)=JMM*1. ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! 1/2 index affectation DO JMM=1,KIBM_LEVEL-1 ZTEMP = PINDI DO JM=1,4 IIMAX = KIE IJMAX = KJE IF (JM==2) IIMAX=IIMAX+1 IF (JM==3) IJMAX=IJMAX+1 IF (JM==4) IIMAX=IIMAX+1 IF (JM==4) IJMAX=IJMAX+1 DO JI=KIB,IIMAX DO JJ=KJB,IJMAX IF (ABS(ZTEMP(JI,JJ,JM)).GT.PIBM_EPSI) GO TO 555 DO JI2=JI-1,JI+1 DO JJ2=JJ-1,JJ+1 IF ((JMM==1).AND.((ABS(ZTEMP(JI2,JJ2,JM)-(2.-JMM*1.))).LT.(PIBM_EPSI))) PINDI(JI,JJ,JM)=-JMM*1. IF ((JMM >1).AND.((ABS(ZTEMP(JI2,JJ2,JM)-(1.-JMM*1.))).LT.(PIBM_EPSI))) PINDI(JI,JJ,JM)=-JMM*1. ENDDO ENDDO 555 CONTINUE ENDDO ENDDO ENDDO ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ENDDO ! 3 index affectation ZTEMP = PINDI JMM = KIBM_LEVEL WHERE ((ABS(ZTEMP(:,:,:)+0.)).LT.(PIBM_EPSI)) PINDI(:,:,:)=-JMM*1. ! communication NULLIFY(TZFIELDS_ll) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,1)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,2)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,3)) CALL ADD2DFIELD_ll(TZFIELDS_ll,PINDI(:,:,4)) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL CLEANLIST_ll(TZFIELDS_ll) ! finalization DEALLOCATE(ZTEMP) END SUBROUTINE INDEX_AFFECT ! END SUBROUTINE IBM_PREP