Merge pull request #15908 from cxp484/FireX

FireX: Merge with firemodels/master

Author: cxp484

Manuals/FDS_Validation_Guide/Velocity_Chapter.tex

@@ -422,7 +422,7 @@ \section{NIST Pool Fires}
 
 \section{PRISME DOOR Experiments}
 
-Bi-directional probes were placed in the doorway separating the two compartments of the PRISME DOOR experiments. Shown on the plots below are the uppermost and lowest measurement points.
+Bi-directional probes were placed in the doorway separating the two compartments of the PRISME DOOR experiments. Figure~\ref{PRISME_Velocity} displays comparisons of the vertical velocity profiles.
 
 \begin{figure}[!ht]
 \begin{tabular*}{\textwidth}{l@{\extracolsep{\fill}}r}

Source/ccib.f90

@@ -15097,7 +15097,7 @@ SUBROUTINE CC_COMPUTE_VELOCITY_ERROR(DT,NM)
          IF (PREDICTOR) THEN
             UN_NEW = U(I,J,K) - DT*(FVX(I,J,K) + IDX*(H(I+1,J,K)-H(I,J,K)))
          ELSE
-            UN_NEW = 0.5_EB*(U(I,J,K)+US(I,J,K)) - DT*(FVX(I,J,K) + IDX*(HS(I+1,J,K)-HS(I,J,K)))
+            UN_NEW = 0.5_EB*( (U(I,J,K)+US(I,J,K)) - DT*(FVX(I,J,K) + IDX*(HS(I+1,J,K)-HS(I,J,K))) )
          ENDIF
       CASE(JAXIS)
          ICC_LO = CCVAR(I,J,K,CC_IDCC); ICC_HI = CCVAR(I,J+1,K,CC_IDCC)
@@ -15107,7 +15107,7 @@ SUBROUTINE CC_COMPUTE_VELOCITY_ERROR(DT,NM)
          IF (PREDICTOR) THEN
             UN_NEW = V(I,J,K) - DT*(FVY(I,J,K) + IDX*(H(I,J+1,K)-H(I,J,K)))
          ELSE
-            UN_NEW = 0.5_EB*(V(I,J,K)+VS(I,J,K)) - DT*(FVY(I,J,K) + IDX*(HS(I,J+1,K)-HS(I,J,K)))
+            UN_NEW = 0.5_EB*( (V(I,J,K)+VS(I,J,K)) - DT*(FVY(I,J,K) + IDX*(HS(I,J+1,K)-HS(I,J,K))) )
          ENDIF
       CASE(KAXIS)
          ICC_LO = CCVAR(I,J,K,CC_IDCC); ICC_HI = CCVAR(I,J,K+1,CC_IDCC)
@@ -15117,7 +15117,7 @@ SUBROUTINE CC_COMPUTE_VELOCITY_ERROR(DT,NM)
          IF (PREDICTOR) THEN
             UN_NEW = W(I,J,K) - DT*(FVZ(I,J,K) + IDX*(H(I,J,K+1)-H(I,J,K)))
          ELSE
-            UN_NEW = 0.5_EB*(W(I,J,K)+WS(I,J,K)) - DT*(FVZ(I,J,K) + IDX*(HS(I,J,K+1)-HS(I,J,K)))
+            UN_NEW = 0.5_EB*( (W(I,J,K)+WS(I,J,K)) - DT*(FVZ(I,J,K) + IDX*(HS(I,J,K+1)-HS(I,J,K))) )
          ENDIF
       END SELECT
    ENDIF

Source/dump.f90

@@ -5860,7 +5860,8 @@ END SUBROUTINE GET_GEOMINFO
 
 SUBROUTINE GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
                         I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,VALS,&
-                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
+                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,&
+                        PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM,OPT_BNDF_INDEX)
 
 USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION
 
@@ -5869,6 +5870,7 @@ SUBROUTINE GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
 REAL(EB), INTENT(IN) :: T,DT
 INTEGER, INTENT(IN) :: I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,&
                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NM
+INTEGER, OPTIONAL,INTENT(IN) :: OPT_BNDF_INDEX
 CHARACTER(*), INTENT(IN) :: SLICETYPE
 LOGICAL, INTENT(IN) :: CC_INTERP2FACES,CC_CELL_CENTERED
 REAL(FB), INTENT(OUT), DIMENSION(NFACES) :: VALS
@@ -6098,7 +6100,7 @@ SUBROUTINE GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
          IF (CCVAR(I,J,K,CC_IDCF) > 0) THEN
             ICF = CCVAR(I,J,K,CC_IDCF)
             DO IFACECF=1,CUT_FACE(ICF)%NFACE
-               VAL_CF = SOLID_PHASE_OUTPUT(ABS(IND),Y_INDEX,Z_INDEX,PART_INDEX, &
+               VAL_CF = SOLID_PHASE_OUTPUT(ABS(IND),Y_INDEX,Z_INDEX,PART_INDEX,OPT_BNDF_INDEX=OPT_BNDF_INDEX, &
                                            OPT_CFACE_INDEX=CUT_FACE(ICF)%CFACE_INDEX(IFACECF))
                NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                DO IVCF = 1, NVF-2 ! face is convex
@@ -6301,11 +6303,12 @@ END SUBROUTINE DUMP_CFACES_GEOM
 SUBROUTINE DUMP_SLICE_GEOM_DATA(FUNIT_DATA,CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE, &
                                 HEADER,STIME,I1,I2,J1,J2,K1,K2,DEBUG,&
                                 IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T, &
-                                DT,NM,SLICE_MIN, SLICE_MAX)
+                                DT,NM,SLICE_MIN, SLICE_MAX, OPT_BNDF_INDEX)
 REAL(EB), INTENT(IN) :: T,DT
 CHARACTER(*), INTENT(IN) :: SLICETYPE
 INTEGER, INTENT(IN) :: FUNIT_DATA,HEADER,I1,I2,J1,J2,K1,K2,DEBUG, &
                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NM
+INTEGER, OPTIONAL,INTENT(IN) :: OPT_BNDF_INDEX
 REAL(FB), INTENT(IN):: STIME
 LOGICAL, INTENT(IN) :: CC_INTERP2FACES,CC_CELL_CENTERED
 REAL(FB), INTENT(OUT) :: SLICE_MIN, SLICE_MAX
@@ -6327,7 +6330,8 @@ SUBROUTINE DUMP_SLICE_GEOM_DATA(FUNIT_DATA,CC_INTERP2FACES,CC_CELL_CENTERED,SLIC
 ! get values at geometry faces
       CALL GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
                        I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,VALS,&
-                       IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
+                       IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,&
+                       PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM,OPT_BNDF_INDEX)
    ELSE
       NVALS = NVERTS
       ALLOCATE(VALS(MAX(NVERTS,NFACES)))
@@ -6341,7 +6345,8 @@ SUBROUTINE DUMP_SLICE_GEOM_DATA(FUNIT_DATA,CC_INTERP2FACES,CC_CELL_CENTERED,SLIC
 
       CALL GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
                         I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,VALS,&
-                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
+                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,&
+                        PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM,OPT_BNDF_INDEX)
 
 ! these two routines need to be moved and called only once
       CALL GET_GEOMINFO(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS,VERTS,FACES,LOCATIONS)
@@ -9089,6 +9094,7 @@ REAL(EB) RECURSIVE FUNCTION GAS_PHASE_OUTPUT(T,DT,NM,II,JJ,KK,IND,IND2,Y_INDEX,Z
       ELSE
          PROBE_DELTA_P = (VEL*FAC)**2*RHO(II,JJ,KK)*0.5_EB
          ! LJ AIR viscosity fit 100 K to 5000 K
+         PROBE_TMP = MIN(5000._EB,MAX(100._EB,PROBE_TMP))
          MU_G = 1.5205E-22_EB*PROBE_TMP**5 - 2.1417E-18_EB*PROBE_TMP**4 + 1.1402E-14_EB*PROBE_TMP**3 - &
                   2.9846E-11_EB*PROBE_TMP**2 + 5.9898E-8_EB*PROBE_TMP + 0.000002352_EB
          JJJ = 1
@@ -9986,6 +9992,7 @@ REAL(EB) FUNCTION SOLID_PHASE_OUTPUT(INDX,Y_INDEX,Z_INDEX,PART_INDEX,OPT_WALL_IN
 
 ENDIF
 
+MATL_INDEX = 0
 IF (PRESENT(OPT_DEVC_INDEX)) MATL_INDEX = DEVICE(OPT_DEVC_INDEX)%MATL_INDEX
 IF (PRESENT(OPT_BNDF_INDEX)) MATL_INDEX = BOUNDARY_FILE(OPT_BNDF_INDEX)%MATL_INDEX
 IF (PRESENT(OPT_PROF_INDEX)) MATL_INDEX = PROFILE(OPT_PROF_INDEX)%MATL_INDEX
@@ -11903,7 +11910,7 @@ SUBROUTINE DUMP_BNDF(T,DT,NM)
          CALL DUMP_SLICE_GEOM_DATA(LU_BNDG(NF,NM), &
                                    .FALSE.,.TRUE.,"INBOUND_FACES",1,STIME,I1,I2,J1,J2,K1,K2,BF%DEBUG, &
                                    IND,0,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,0,0,BF%PROP_INDEX,0,0,T,DT,NM, &
-                                   BOUND_MIN, BOUND_MAX)
+                                   BOUND_MIN, BOUND_MAX, OPT_BNDF_INDEX=NF)
          BNDF_VAL_MIN = BOUND_MIN
          BNDF_VAL_MAX = BOUND_MAX
          CHANGE_BOUND = 1
@@ -11913,7 +11920,7 @@ SUBROUTINE DUMP_BNDF(T,DT,NM)
          CALL DUMP_SLICE_GEOM_DATA(LU_BNDG(NF,NM), &
                          .FALSE.,.TRUE.,"INBOUND_FACES",0,STIME,I1,I2,J1,J2,K1,K2,BF%DEBUG, &
                          IND,0,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,0,0,BF%PROP_INDEX,0,0,T,DT,NM, &
-                         BOUND_MIN, BOUND_MAX)
+                         BOUND_MIN, BOUND_MAX, OPT_BNDF_INDEX=NF)
          OPEN(LU_BNDG(NF+N_BNDF,NM),FILE=FN_BNDG(NF+N_BNDF,NM), ACTION='READ')
          READ(LU_BNDG(NF+N_BNDF,NM),FMT=*,IOSTAT=IERROR)BNDF_TIME, BNDF_VAL_MIN, BNDF_VAL_MAX
          CLOSE(LU_BNDG(NF+N_BNDF,NM))

Source/hvac.f90

@@ -491,8 +491,8 @@ SUBROUTINE READ_HVAC
          IF (DN%N_DUCTS >=2) THEN
             DN%LOSS_ARRAY = LOSS(1:DN%N_DUCTS,1:DN%N_DUCTS)
          ELSE
-            DN%LOSS_ARRAY(1,2) = LOSS(1,1)
-            DN%LOSS_ARRAY(2,1) = LOSS(2,1)
+            DN%LOSS_ARRAY(1,2) = LOSS(2,1)
+            DN%LOSS_ARRAY(2,1) = LOSS(1,1)
          ENDIF
 
          IF (NETWORK_ID=='null') THEN

Source/main.f90

@@ -204,6 +204,7 @@ PROGRAM FDS
    CALL INITIALIZE_ATMOSPHERE(NM)
    IF (.NOT.SETUP_ONLY .OR. CHECK_MESH_ALIGNMENT) CALL INITIALIZE_WALL_ARRAY(NM)
 ENDDO
+CALL STOP_CHECK(1)
 IF (MY_RANK==0 .AND. VERBOSE) CALL VERBOSE_PRINTOUT('Completed INITIALIZE_WALL_ARRAY')
 
 CALL PROC_HVAC

Source/prec.f90

@@ -40,9 +40,9 @@ MODULE PRECISION_PARAMETERS
 REAL(EB), PARAMETER :: ONE_M_EPS=1._EB-100._EB*EPSILON(1._EB) !< Number that is slightly less than 1
 REAL(EB), PARAMETER :: ONE_P_EPS=1._EB+100._EB*EPSILON(1._EB) !< Number that is slightly greater than 1
 REAL(EB), PARAMETER :: MICRON=1.E-6_EB                        !< A relatively small length (m)
-REAL(QB), PARAMETER :: TWO_EPSILON_QB=2._QB*EPSILON(1._QB)    !< A very small number 16 byte accuracy
-REAL(EB), PARAMETER :: TWO_EPSILON_EB=2._EB*EPSILON(1._EB)    !< A very small number 8 byte accuracy
-REAL(FB), PARAMETER :: TWO_EPSILON_FB=2._EB*EPSILON(1._FB)    !< A very small number 4 byte accuracy
+REAL(QB), PARAMETER :: TWO_EPSILON_QB=20._QB*EPSILON(1._QB)    !< A very small number 16 byte accuracy
+REAL(EB), PARAMETER :: TWO_EPSILON_EB=20._EB*EPSILON(1._EB)    !< A very small number 8 byte accuracy
+REAL(FB), PARAMETER :: TWO_EPSILON_FB=20._EB*EPSILON(1._FB)    !< A very small number 4 byte accuracy
 REAL(EB), PARAMETER :: TINY_EB=TINY(1._EB)                    !< The smallest resolvable 8 byte real number
 REAL(EB), PARAMETER :: HUGE_EB=HUGE(1._EB)                    !< The largest resolvable 8 btye real number
 REAL(EB), PARAMETER :: HUGE_FB=HUGE(1._FB)                    !< A large number but not too large for various operations

Source/read.f90

@@ -10710,7 +10710,7 @@ SUBROUTINE READ_OBST(QUICK_READ)
 TYPE(OBSTRUCTION_TYPE), POINTER :: OB2,OBT
 TYPE(MULTIPLIER_TYPE), POINTER :: MR
 TYPE(OBSTRUCTION_TYPE), DIMENSION(:), ALLOCATABLE, TARGET :: TEMP_OBSTRUCTION
-INTEGER :: I,NM,NOM,NOM2,N_OBST_O,IC,N,NN,NNN,NNNN,N_NEW_OBST,RGB(3),N_OBST_DIM,II,JJ,KK,MULT_INDEX,SHAPE_TYPE,IIO,JJO,KKO,IOR,&
+INTEGER :: I,NM,NOM,N_OBST_O,IC,N,NN,NNN,NNNN,N_NEW_OBST,RGB(3),N_OBST_DIM,II,JJ,KK,MULT_INDEX,SHAPE_TYPE,IIO,JJO,KKO,IOR,&
            N_LAYER_CELLS_MAX
 CHARACTER(LABEL_LENGTH) :: ID,DEVC_ID,SHAPE,SURF_ID,SURF_ID_INTERIOR,SURF_IDS(3),SURF_ID6(6),CTRL_ID,MULT_ID,&
                            MATL_ID(MAX_MATERIALS),RAMP_IHS
@@ -10998,90 +10998,83 @@ SUBROUTINE READ_OBST(QUICK_READ)
                IF (XB3+XB4<2._EB*YS .OR. XB3+XB4>2._EB*YF) THICKEN_DIR(2) = .FALSE.
                IF (XB5+XB6<2._EB*ZS .OR. XB5+XB6>2._EB*ZF) THICKEN_DIR(3) = .FALSE.
 
-               IF (XB2>=XS-0.5_EB*DX(0) .AND. XB2<XS) THEN
-                  DX_GHOST = DX(0)
+               IF (XB2<XS .AND. XB4>YS .AND. XB3<YF .AND. XB6>ZS .AND. XB5<ZF) THEN
                   CALL SEARCH_OTHER_MESHES(XS-0.01_EB*DX(0),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
                                            NOM,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  CALL SEARCH_OTHER_MESHES(XS-0.51_EB*DX(0),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
-                                           NOM2,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  IF (NOM==0 .AND. NOM2>0) REJECT_OBST = .TRUE.
-                  IF (NOM>0) THEN
-                     IF (ALLOCATED(MESHES(NOM)%DX)) DX_GHOST = MESHES(NOM)%DX(IIO)
+                  IF (NOM>0 .AND. PROCESS(NM)==MY_RANK) THEN
+                     DX_GHOST = MESHES(NOM)%DX(IIO)
+                  ELSE
+                     DX_GHOST = DX(0)
                   ENDIF
                   IF (XB2>=XS-0.5_EB*DX_GHOST) THEN
                      XB1 = XS
                      XB2 = XS
                   ENDIF
                ENDIF
-               IF (XB1<XF+0.5_EB*DX(IBP1) .AND. XB1>XF) THEN
-                  DX_GHOST = DX(IBP1)
+
+               IF (XB1>XF .AND. XB4>YS .AND. XB3<YF .AND. XB6>ZS .AND. XB5<ZF) THEN
                   CALL SEARCH_OTHER_MESHES(XF+0.01_EB*DX(IBP1),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
                                            NOM,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  CALL SEARCH_OTHER_MESHES(XF+0.51_EB*DX(IBP1),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
-                                           NOM2,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  IF (NOM==0 .AND. NOM2>0) REJECT_OBST = .TRUE.
-                  IF (NOM>0) THEN
-                     IF (ALLOCATED(MESHES(NOM)%DX)) DX_GHOST = MESHES(NOM)%DX(IIO)
+                  IF (NOM>0 .AND. PROCESS(NM)==MY_RANK) THEN
+                     DX_GHOST = MESHES(NOM)%DX(IIO)
+                  ELSE
+                     DX_GHOST = DX(IBP1)
                   ENDIF
                   IF (XB1<XF+0.5_EB*DX_GHOST) THEN
                      XB1 = XF
                      XB2 = XF
                   ENDIF
                ENDIF
-               IF (XB4>=YS-0.5_EB*DY(0) .AND. XB4<YS) THEN
-                  DY_GHOST = DY(0)
+
+               IF (XB4<YS .AND. XB2>XS .AND. XB1<XF .AND. XB6>ZS .AND. XB5<ZF) THEN
                   CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),YS-0.01_EB*DY(0),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
                                            NOM,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),YS-0.51_EB*DY(0),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
-                                           NOM2,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  IF (NOM==0 .AND. NOM2>0) REJECT_OBST = .TRUE.
-                  IF (NOM>0) THEN
-                     IF (ALLOCATED(MESHES(NOM)%DY)) DY_GHOST = MESHES(NOM)%DY(JJO)
+                  IF (NOM>0 .AND. PROCESS(NM)==MY_RANK) THEN
+                     DY_GHOST = MESHES(NOM)%DY(JJO)
+                  ELSE
+                     DY_GHOST = DY(0)
                   ENDIF
                   IF (XB4>=YS-0.5_EB*DY_GHOST) THEN
                      XB3 = YS
                      XB4 = YS
                   ENDIF
                ENDIF
-               IF (XB3<YF+0.5_EB*DY(JBP1) .AND. XB3>YF) THEN
-                  DY_GHOST = DY(JBP1)
+
+               IF (XB3>YF .AND. XB2>XS .AND. XB1<XF .AND. XB6>ZS .AND. XB5<ZF) THEN
                   CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),YF+0.01_EB*DY(JBP1),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
                                            NOM,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),YF+0.51_EB*DY(JBP1),0.5_EB*(MAX(ZS,XB5)+MIN(ZF,XB6)),&
-                                           NOM2,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  IF (NOM==0 .AND. NOM2>0) REJECT_OBST = .TRUE.
-                  IF (NOM>0) THEN
-                     IF (ALLOCATED(MESHES(NOM)%DY)) DY_GHOST = MESHES(NOM)%DY(JJO)
+                  IF (NOM>0 .AND. PROCESS(NM)==MY_RANK) THEN
+                     DY_GHOST = MESHES(NOM)%DY(JJO)
+                  ELSE
+                     DY_GHOST = DY(JBP1)
                   ENDIF
-                  IF (XB3<YS+0.5_EB*DY_GHOST) THEN
+                  IF (XB3<YF+0.5_EB*DY_GHOST) THEN
                      XB3 = YF
                      XB4 = YF
                   ENDIF
                ENDIF
-               IF (XB6>=ZS-0.5_EB*DZ(0) .AND. XB6<ZS) THEN
-                  DZ_GHOST = DZ(0)
+
+               IF (XB6<ZS .AND. XB2>XS .AND. XB1<XF .AND. XB4>YS .AND. XB3<YF) THEN
                   CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),ZS-0.01_EB*DZ(0),&
                                            NOM,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),ZS-0.51_EB*DZ(0),&
-                                           NOM2,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  IF (NOM==0 .AND. NOM2>0) REJECT_OBST = .TRUE.
-                  IF (NOM>0) THEN
-                     IF (ALLOCATED(MESHES(NOM)%DZ)) DZ_GHOST = MESHES(NOM)%DZ(KKO)
+                  IF (NOM>0 .AND. PROCESS(NM)==MY_RANK) THEN
+                     DZ_GHOST = MESHES(NOM)%DZ(KKO)
+                  ELSE
+                     DZ_GHOST = DZ(0)
                   ENDIF
                   IF (XB6>=ZS-0.5_EB*DZ_GHOST) THEN
                      XB5 = ZS
                      XB6 = ZS
                   ENDIF
                ENDIF
-               IF (XB5<ZF+0.5_EB*DZ(KBP1) .AND. XB5>ZF) THEN
-                  DZ_GHOST = DZ(KBP1)
+
+               IF (XB5>ZF  .AND. XB2>XS .AND. XB1<XF .AND. XB4>YS .AND. XB3<YF) THEN
                   CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),ZF+0.01_EB*DZ(KBP1),&
                                            NOM,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  CALL SEARCH_OTHER_MESHES(0.5_EB*(MAX(XS,XB1)+MIN(XF,XB2)),0.5_EB*(MAX(YS,XB3)+MIN(YF,XB4)),ZF+0.51_EB*DZ(KBP1),&
-                                           NOM2,IIO,JJO,KKO,XXI,YYJ,ZZK)
-                  IF (NOM==0 .AND. NOM2>0) REJECT_OBST = .TRUE.
-                  IF (NOM>0) THEN
-                     IF (ALLOCATED(MESHES(NOM)%DZ)) DZ_GHOST = MESHES(NOM)%DZ(KKO)
+                  IF (NOM>0 .AND. PROCESS(NM)==MY_RANK) THEN
+                     DZ_GHOST = MESHES(NOM)%DZ(KKO)
+                  ELSE
+                     DZ_GHOST = DZ(KBP1)
                   ENDIF
                   IF (XB5<ZF+0.5_EB*DZ_GHOST) THEN
                      XB5 = ZF