FDS Source: Allow HT3D OBSTs to abut mesh boundary

mcgratta · Nov 1, 2023 · 088983f · 088983f
1 parent 52cf873
commit 088983f
Showing 1 changed file with 24 additions and 33 deletions.
diff --git a/Source/init.f90 b/Source/init.f90
@@ -1609,12 +1609,12 @@ SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
 TYPE(MATERIAL_TYPE), POINTER :: ML
 REAL(EB), ALLOCATABLE, DIMENSION(:) :: X_S_OLD
 LOGICAL, ALLOCATABLE, DIMENSION(:) :: REMESH_LAYER
-TYPE(WALL_TYPE), POINTER :: WC,WCB
-TYPE(THIN_WALL_TYPE), POINTER :: TW,TWB
+TYPE(WALL_TYPE), POINTER :: WC
+TYPE(THIN_WALL_TYPE), POINTER :: TW
 TYPE(SURFACE_TYPE), POINTER :: SF
 TYPE(BOUNDARY_ONE_D_TYPE), POINTER :: ONE_D
 TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC
-TYPE(MESH_TYPE), POINTER :: M,M2
+TYPE(MESH_TYPE), POINTER :: M
 TYPE(OBSTRUCTION_TYPE), POINTER :: OB
 TYPE(STORAGE_TYPE), POINTER :: OS_DUMMY
 
@@ -1624,21 +1624,16 @@ SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
    WC => M%WALL(WALL_CELL)
    SF => SURFACE(WC%SURF_INDEX)
    IF (.NOT.SF%HT1D .AND. .NOT.SF%HT_DIM>1) RETURN
+   IF (WC%BOUNDARY_TYPE/=SOLID_BOUNDARY) RETURN
    IF (SF%NORMAL_DIRECTION_ONLY) RETURN
    ONE_D => M%BOUNDARY_ONE_D(WC%OD_INDEX)
-   IF (ONE_D%BACK_INDEX==0) RETURN
-   M2  => MESHES(ONE_D%BACK_MESH)   ! M2 can be M
-   WCB => M2%WALL(ONE_D%BACK_INDEX)
    BC  => M%BOUNDARY_COORD(WC%BC_INDEX)
    OB => M%OBSTRUCTION(WC%OBST_INDEX)
 ELSEIF (PRESENT(THIN_WALL_CELL)) THEN
    TW => M%THIN_WALL(THIN_WALL_CELL)
    SF => SURFACE(TW%SURF_INDEX)
    IF (SF%HT_DIM==1) RETURN
    ONE_D => M%BOUNDARY_ONE_D(TW%OD_INDEX)
-   IF (ONE_D%BACK_INDEX==0) RETURN
-   M2  => MESHES(ONE_D%BACK_MESH)   ! M2 can be M
-   TWB => M2%THIN_WALL(ONE_D%BACK_INDEX)
    BC  => M%BOUNDARY_COORD(TW%BC_INDEX)
    OB => M%OBSTRUCTION(TW%OBST_INDEX)
 ENDIF
@@ -3661,16 +3656,10 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
       IF (KK==0)       ZZC = OM%Z(KK)   - MESH_SEPARATION_DISTANCE
       IF (KK==OM%KBP1) ZZC = OM%Z(KK-1) + MESH_SEPARATION_DISTANCE
       CALL SEARCH_OTHER_MESHES(XXC,YYC,ZZC,NOM,II,JJ,KK)
-      IF (NOM==0) THEN
-         IF (SF%HT_DIM>1) THEN
-            WRITE(LU_ERR,'(A,A,A)') 'ERROR: SURF ',TRIM(SF%ID),' is HT3D and cannot extend beyond the computational domain'
-            STOP_STATUS = SETUP_STOP
-            RETURN
-         ENDIF
-         RETURN
+      IF (NOM>0) THEN
+         IF (.NOT.PROCESS_MESH_NEIGHBORHOOD(NOM)) RETURN  ! If NOM not controlled by current MPI process, abandon search
+         OM => MESHES(NOM)
       ENDIF
-      IF (.NOT.PROCESS_MESH_NEIGHBORHOOD(NOM)) RETURN  ! If NOM not controlled by current MPI process, abandon search
-      OM => MESHES(NOM)
    ENDIF
 
    OLD_THICKNESS = THICKNESS
@@ -3728,25 +3717,27 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
 
    ! Determine if the back face is found
 
-   IF (.NOT.OM%CELL(IC)%SOLID .AND. OM%CELL(IC)%WALL_INDEX(IOR)>0) THEN ! the back wall face is found
+   IF ((.NOT.OM%CELL(IC)%SOLID .AND. OM%CELL(IC)%WALL_INDEX(IOR)>0) .OR. NOM==0) THEN ! the back wall face is found
       ONE_D%BACK_INDEX = OM%CELL(IC)%WALL_INDEX(IOR)
       ONE_D%BACK_MESH  = NOM
       ONE_D%BACK_SURF  = OM%CELL(IC)%SURF_INDEX(IOR)
-      OS => M%OMESH(NOM)%WALL_RECV_BUFFER
-      IF (.NOT.ALLOCATED(OS%ITEM_INDEX)) THEN
-         OS%N_ITEMS_DIM = 50
-         ALLOCATE(OS%ITEM_INDEX(1:OS%N_ITEMS_DIM))
-         ALLOCATE(OS%SURF_INDEX(1:OS%N_ITEMS_DIM))
-      ENDIF
-      IF (COUNT(OS%ITEM_INDEX(1:OS%N_ITEMS)==ONE_D%BACK_INDEX)==0) THEN
-         IF (OS%N_ITEMS>=OS%N_ITEMS_DIM) THEN
-            CALL REALLOCATE_INTEGER_ARRAY(OS%ITEM_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
-            CALL REALLOCATE_INTEGER_ARRAY(OS%SURF_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
-            OS%N_ITEMS_DIM = OS%N_ITEMS_DIM + 50
+      IF (NOM>0) THEN
+         OS => M%OMESH(NOM)%WALL_RECV_BUFFER
+         IF (.NOT.ALLOCATED(OS%ITEM_INDEX)) THEN
+            OS%N_ITEMS_DIM = 50
+            ALLOCATE(OS%ITEM_INDEX(1:OS%N_ITEMS_DIM))
+            ALLOCATE(OS%SURF_INDEX(1:OS%N_ITEMS_DIM))
+         ENDIF
+         IF (COUNT(OS%ITEM_INDEX(1:OS%N_ITEMS)==ONE_D%BACK_INDEX)==0) THEN
+            IF (OS%N_ITEMS>=OS%N_ITEMS_DIM) THEN
+               CALL REALLOCATE_INTEGER_ARRAY(OS%ITEM_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
+               CALL REALLOCATE_INTEGER_ARRAY(OS%SURF_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
+               OS%N_ITEMS_DIM = OS%N_ITEMS_DIM + 50
+            ENDIF
+            OS%N_ITEMS = OS%N_ITEMS + 1
+            OS%ITEM_INDEX(OS%N_ITEMS) = ONE_D%BACK_INDEX
+            OS%SURF_INDEX(OS%N_ITEMS) = ONE_D%BACK_SURF
          ENDIF
-         OS%N_ITEMS = OS%N_ITEMS + 1
-         OS%ITEM_INDEX(OS%N_ITEMS) = ONE_D%BACK_INDEX
-         OS%SURF_INDEX(OS%N_ITEMS) = ONE_D%BACK_SURF
       ENDIF
       EXIT FIND_BACK_WALL_CELL
    ENDIF